Копирование массива данных со страницы на страницу - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д