Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос сбора данных из нескольких листов и вставка в один общий лист, Прайс-лист из нескольких листов в книге.
 
Прошу оказать содействие в написании Макроса для сбора данных на Лист “Результат” в формате "Таблица с заголовками". Диапазон собираемых данных A2:J~  с Листов указанных в Листе “Справочник листов”, а дальше со столбца K2:R~ работают формулы, которые я написал. Файл пример во вложении

На Листе “Результаты” приведен пример. Желтая полоса – данные с листов указанные в Листе “Справочник лисов”, Диапазон A2:J97.
На Листе “Акции” заносятся позиции по которым периодически проводятся акции с указанием интервала времени. Если товар участвует в акции то в столбец K2:K~ подставляется по формуле ИНДЕКС(ПОИСКПОЗ( ……
На Листе “Курсы валют” заносятся курсы валют, которые меняются с определенным интервалом, для примера смена каждую неделю.
В столбец L2:L~ Лист “Результат” подставляется значение текущего курса по формуле ИНДЕКС(ПОИСКПОЗ( ……
Аналогичное происходит с Листом “Скидки” и Столбцами N2:N~ и P2:P~
Изменено: max_2311 - 21 Фев 2015 22:43:35
 
Код
Sub Сбор_Данных()
Set shSh = Sheets("Справочник листов")
Set shOUT = Sheets("Результат")
lrSh = shSh.Cells(Rows.Count, 1).End(xlUp).Row
shArr = Range("A1:A" & lrSh)
Set dic = CreateObject("Scripting.Dictionary")
For ssh = 1 To lrSh
Set sh = Sheets(shSh.Cells(ssh, 1).Value)
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
    If sh.Cells(i, "D").Value = "" Then
    ii = i
    Else
    k = k + 1
    gg = sh.Range("B" & ii).Value
    arr = Array(sh.Name, sh.[A1].Value, sh.Range("A" & i).Value, sh.Range("B" & ii).Value, _
                sh.Range("D" & i).Value, sh.Range("B" & i).Value, sh.Range("C" & i).Value, _
                sh.Range("E" & i).Value, sh.Range("F" & i).Value, sh.Range("G" & i).Value)
    dic.Item(k) = arr
    End If
    Next
Next
lr = shOUT.UsedRange.Rows.Count
arr = Application.Transpose(Application.Transpose(dic.items))
shOUT.Range("A" & UBound(arr) + 3, "J" & lr).Clear
shOUT.Range("A3").Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
Работать надо не 12 часов, а головой.
 
Спасибо.
Все работает.

- "Работать надо не 12 часов, а головой."  :D
 
В файле замечена некорректная работа макроса, так как листы с которых ведется перенос данных на один общий лист имеют разное количество столбцов, при этом происходит смещение столбцов. В общем листе переносимые данные должны размещаться строго в своем столбце. Свое место расположения в столбцах должно происходить в шапке таблицы их названия столбцов.
На листе Ошибки склейки листов показана ошибка и вариант правки.
Изменено: max_2311 - 28 Фев 2015 14:20:59
 
Цитата
max_2311 написал: листы с которых ведется перенос данных на один общий лист имеют разное количество столбцов
неожиданно выяснилось? через неделю? :)
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Посмотрите. Правда есть одна неоднозначность на листе "Цельнолитые шины" две колонки с "ценой". С которой брать данные? Сейчас стоит с первой.
Работать надо не 12 часов, а головой.
 
Цены нужно брать с первого столбца
Страницы: 1
Читают тему (гостей: 1)