Копирование массива данных со страницы на страницу - VBA
Формулировка задачи:
День добрый.
Впервые столкнулся с необходимостью создания макроса на Excel, нужна помощь специалистов
Есть книга Excel, в ней 2 листа с таблицами:
Таблица 1 (Лист 1)
Таблица 2 (Лист 2)
Из первой таблицы во вторую необходимо перенести, например, все данные из столбцов "ФИО" и "Подразделение". При этом количество строк будет варьироваться. То есть нужно, чтобы копировались данные не строго с А2 по А10, а, как бы, с А2 по Абесконечность. Это вообще возможно?
Решение задачи: «Копирование массива данных со страницы на страницу»
textual
Листинг программы
Option Explicit
'Ключи собираем одним циклом по исходным данным.
'Затем вложенные циклы (3 шт.) по итогу:
'1 - по фио
'2 - по шапке первая строка с шагом 3
'3 - по шапке вторая строка 1-3
'собираем из этих 3-х значений ключ, если есть в словаре - извлекаем данные.
Sub tt()
Dim a(), i&, ii&, iii&, t$
Dim d1 As Object, d2 As Object
Application.ScreenUpdating = False
a = Sheets(1).[a1].CurrentRegion.Value
Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1
For i = 2 To UBound(a)
d1.Item(a(i, 1) & "|" & a(i, 8)) = a(i, 9)
d2.Item(a(i, 1)) = a(i, 3)
Next
With Sheets(2)
.UsedRange.Offset(2).ClearContents
.[a3].Resize(d2.Count, 2) = Application.Transpose(Array(d2.keys, d2.items)) 'вываливаем фамилии и должности
For i = 3 To 2 + d2.Count
For ii = 3 To 12 Step 3
For iii = 1 To 3
t = .Cells(i, 1) & "|" & .Cells(1, ii) & "." & .Cells(2, ii + iii - 1)
If d1.exists(t) Then .Cells(i, ii + iii - 1) = d1.Item(t)
Next: Next: Next
End With
Application.ScreenUpdating = True
End Sub