Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для создания отдельной таблицы с данными из определенных столбцов из другой таблицы с накоплением.
 
#1
04.07.2014 16:31:12
Доброго Всем дня дорогие форумчане и разбирающиеся в макросах и excel!
Появилась в ходе создания базы данных студентов необходимость в подсчете зарплаты преподавателей по месяцам. Задача оказалась не из легких, так как таблица с базой данных имеет не совсем удобную структуру и здесь я думаю без макроса не обойтись. Возможно и есть способ решения без макросов но такого к сожалению я не сумела найти. Может кто из знающих подскажет, как здесь быть, выведет из тупика. Я думала, что разберусь своими силами, но все тщетно:(
Попытаюсь объяснить, как можно проще
Есть исходная основная таблица:
Имя студентаТип курсаПрепод.Дата нач. обуч.Кол. днейЗавер-шилДат Завер-шенияСуммаТип курсаПреподДата нач. обуч.Кол. днейЗавер-шилДат Завер-шенияСумма
Андрей АршавинГрам-матикаАлексей15 май23Завер-шил17 июн2 000  IELTSВася16 июл23Завер-шил22 авг4 000  
Надо преобразовать в следующую таблицу, которая автоматически должна обновляться при добавлении студентов в исходную таблицу:
ИмяТип курсаПрепод.Дата нач. обуч.Кол.  днейЗавершилДат ЗавершенияСумма
Андрей АршавинГрамматикаАлексей15.07.201423Завершил17.07.2014 2 000  
Андрей АршавинIELTSВася16.07.201423Завершил22.07.2014 4 000  
Для лучшего понимания задачи приложила сам файл.

Очень надеюсь на Вашу помощь дорогие форумчане!
 
 
 
#2
04.07.2014 16:31:59
Файла нет.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#3
04.07.2014 16:44:03
Файл почему то никак не прикрепляется. Показывает все время ошибку  
 
 
 
#4
04.07.2014 16:44:51
Макросом сделать можно, вот только "которая автоматически должна обновляться при добавлении студентов в исходную таблицу" зачем?
Когда хотите посмотреть эту вторую таблицу - выполнили макрос и посмотрели. Потому что вот это "при добавлении студентов" именно в какой момент произойдёт? Если укажете точно момент - тогда можем сделать чтоб на это событие срабатывал макрос.
Но чтоб делать - нужен конечно файл.
Изменено: Hugo - 04.07.2014 16:45:12
 
 
 
#5
04.07.2014 16:47:30
Нажать на кнопку когда нужно и получить обновленную таблицу это то что надо!!
 
 
 
#6
04.07.2014 16:47:36
Обрежьте свою базу - т.к. 1 - она не лезет 2 - личные данные публиковать закон разве не запрещает? 3 - вряд ли Вы все личные данные заменили на чужие личные данные :) 4 - нам эта база не нужна.
 
 
 
#7
04.07.2014 16:49:32
Hugo спасибо Вам, что отозвались на помощь. Очень приятно быть услышанной.
 
 
 
#8
04.07.2014 17:01:26
database.zip
 
 
 
#9
04.07.2014 17:04:01
Код на кнопку:

Код
Sub obrabotka()
    Dim r As Range, a(), i&, ii&, x&
    With Sheets(1)
        Set r = .Range("A1:H1")
        a = .Range("A1").CurrentRegion.Value
    End With

    ReDim b(1 To UBound(a) * 2 - 1, 1 To 8)
    For i = 2 To UBound(a)
        ii = ii + 1
        For x = 1 To 8: b(ii, x) = a(i, x): Next
        ii = ii + 1: b(ii, 1) = a(i, 1)
        For x = 2 To 8: b(ii, x) = a(i, x + 7): Next
    Next
    With Sheets(2)
        .UsedRange.Clear
        r.Copy .[a1]
        .[a2].Resize(ii, 8) = b
    End With
End Sub
Будет файл - может нужно будет что-то подправить.
Изменено: Hugo - 04.07.2014 17:06:12
 
 
 
#10
04.07.2014 17:08:03
Ссылка на файл не ссылка на файл... :(
 
 
 
#11
04.07.2014 17:12:35
Ура! Кажется получило

Файлы удалены: превышение допустимого размера вложения. ПРАВИЛА!!! [МОДЕРАТОР]
 
 
 
#12
04.07.2014 17:13:35
Счас получите...
 
 
 
#13
04.07.2014 17:18:15
Буду Век благодарна!!! Вы просто HUGO чудо!
 
 
 
#14
04.07.2014 17:21:27
Не то получите... От модератора. :(
 
 
 
#15
04.07.2014 17:49:56
Файл я скачал - пытался поджать, но без удаления объектов сильно меньше 100 не получается...
Вообще мой алгоритм подходит - но нужно подгонять цифры и плодить эти блоки копирования данных из массива в массив.
И ещё вопрос - всегда будет 7 месяцев?
Но сейчас реализовывать некогда. И на выходных тоже будет некогда... Напомните на следующей неделе, если сами не решите (ну или может ещё кто другой сделает).
 
 
 
#16
04.07.2014 18:00:39
Цитата
Буду Век благодарна!
За то, что удалил файлы? Или за ссылку на правила? Не за что, сами найдете.
 
 
 
#17
04.07.2014 18:39:40
Hugo, Ваш алгоритм выполняет задачу. Надо только ее приспособить к моей таблице. Я уже пытаюсь с ней работать и подстроить под себя. Посмотрим, что получится. Большое Вам спасибо. Сама бы никогда не додумалась это точно. Если ничего не выйдет я надеюсь Вы появитесь на следующей неделе.
 
 
 
#18
04.07.2014 18:41:11
Ах да Hugo! Всегда будет 7 месяцев.
 
 
 
#19
04.07.2014 18:41:39
bekzus, найдите время - ознакомьтесь с Правилами.
 
 
 
#20
04.07.2014 18:42:42
Вот я начал переделывать - но думаю там эти внутренние циклы нужно убирать, т.к. диапазоны не сплошные:

Код
Sub obrabotka()
    Dim r As Range, a(), i&, ii&, x&
    With Sheets(1)
        Set r = Union(.Range("A1:E1"), .Range("H1:I1"), .Range("K1"), .Range("M1:N1"), .Range("AA1"), .Range("AC1"), .Range("P1"))
        a = .Range("A1").CurrentRegion.Value
    End With

    ReDim b(1 To UBound(a) * 7, 1 To 14)
    For i = 3 To UBound(a)
        ii = ii + 1
        For x = 1 To 14: b(ii, x) = a(i, x): Next
        ii = ii + 1: b(ii, 1) = a(i, 1)
        For x = 2 To 14: b(ii, x) = a(i, x + 7): Next
    Next
    With Sheets(2)
        .UsedRange.Clear
        r.Copy .[a1]
        .DrawingObjects.Delete
        .[a2].Resize(ii, 8) = b
    End With
End Sub
Это всё сыро, все числа нужно править.
 
 
 
#21
05.07.2014 12:54:02
Hugo, знаете применить Ваш алгоритм к оригинальной таблице получилось! Только вот для этого мне пришлось внести изменения к самой таблице, удалив некоторые не столь жизненно важные столбцы, а также не получилось отобрать только отдельные нужные столбцы (то есть не знаю как это делается и возможно ли это). Пришлось копировать весь диапазон с 1 по 22 столбец. В общем приспособила не алгоритм к таблице, а наоборот таблицу к алгоритму. Вот так вот, когда не знаешь все совсем не просто:( Тем не менее, это решает мою задачу, а это то что надо! Человеческое Вам спасибо Hugo за помощь. Хотела файл прикрепить, вот только он какой то большой совсем и модераторы уже ругались. Так что, если вдруг захотите взглянуть и удивится моим 'шедевром' могу выслать вам на личку :D  Еще раз премного благодарна!
 
 
 
#22
05.07.2014 13:01:42
Замечательный и возможно самый эффективный форум в инете! Спасибо создателям!
 
 
 
#23
05.07.2014 14:03:40
Можно выбрать отдельные столбцы (я ведь написал выше " но думаю там эти внутренние циклы нужно убирать, т.к. диапазоны не сплошные" ;)  - вот вместо этого

Код
For x = 1 To 14: b(ii, x) = a(i, x): Next
пишите

Код
b(ii,1)=a(i,1) 
b(ii,2)=a(i,5) 
b(ii,3)=a(i,7) 
и т.д.

так из массива 1234567 переложите в b только 157.
ну и массив  b задайте в ширину на столько столбцов, сколько нужно.
Будет код чуть длиннее, но зато проще для понимания.

Т.е. берёте в a() весь диапазон, идёте по этому массиву сверху вниз и слева направо (после фамилии и первых данных)
Увеличили строку в b(), скопировали фамилию и начало, выбираете нужные столбцы первого месяца.Когда их скопировали - увеличиваем строку в b() снова копируем фамилию и начало, копируем столбцы следующего месяца.
Без этих внутренних циклов код будет читаться проще, будет визуально некий порядок.
Когда массив собран - выгрузка на лист, практически уже готово, только в .[a2].Resize(ii,  8)  = b исправить этот смайлик на нужное число.
 
 
 
#24
05.07.2014 18:36:31
Hugo! Получилось!!!! Действительно макросы это просто сказка. Я так счастлива, что смогла применить его сама. Еще раз огромное спасибо Вам! Вы супер!! :*
 
 
 
#25
05.07.2014 18:56:28
Это Вы супер :)
Диапазоны/массивы  и циклы по ним уже освоили - теперь ещё словарь и коллекцию на какой-нибудь задаче применить-понять и думаю 90% будущих задач сможете решать оптимально сами без посторонней помощи.
Думаю в будущем в любой работе Вам эти навыки обязательно пригодятся, пока будет жив Excel. Да даже если уже и не будет :)
 
 
 
Страницы: 1
Наверх