Макрос Excel - итеративное копирование строк с одного листа на другой

Question

В рабочей книге 3 листа: Лист1, Лист2, Лист3.Sheet1 содержит следующие данные:

aaa    3
aaa    2
aaa    45
aaa    211
aaa    12
bbbb   3
bbbb   2
bbbb   4
ccc    2
ccc    5
dddd   2
dddd   10
dddd   25

Будет хэш-таблица, подобная этой:

key        values
GroupA     aaa, bbbb
GroupB     ccc, dddd

Как я могу загрузить данные на другие листы Sheet2 и Sheet3 так, чтобы Sheet2 содержал всестроки с «GroupA» и Sheet3 имеет все строки с «GroupB», присутствующие в Sheet1, используя подпрограмму макроса?

РЕДАКТИРОВАТЬ:
Я хотел бы использовать хеш-таблицу структуры для хранения GroupA, GroupB и т. Д. С их значениями и итеративной обработки sheet1 соответственно, по каждой группе.

Answer 1

Вы можете использовать ADO.

Dim cn As Object
Dim rs As Object
Dim rs2 As Object
Dim sFile As String
Dim sCon As String
Dim sSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

sFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs2 = CreateObject("ADODB.Recordset")


cn.Open sCon

sSQL = "SELECT Key, [Values] " _
       & "FROM [Sheet2$] "

rs.Open sSQL, cn, 3, 3

i = 3
Do While Not rs.EOF

    sSQL = "SELECT Key, [Values] " _
           & "FROM [Sheet1$] " _
           & "WHERE '" & rs![Values] _
           & "' Like '%' & Key & '%' "

    rs2.Open sSQL, cn, 3, 3

    ''Pick a suitable empty worksheet for the results
    ''Worksheets.Add
    With Worksheets("Sheet" & i)
        .Cells(1, 1) = rs!Key

        For j = 0 To rs.Fields.Count - 1
            .Cells(2, j + 1) = rs.Fields(j).Name
        Next

        .Cells(3, 1).CopyFromRecordset rs2
    End With

    rs.MoveNext
    i = i + 1
    rs2.Close
Loop

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Answer 2

Вы должны придерживаться стиля таблицы? Я думаю, было бы проще, если бы вы включили группу в дополнительный столбец листа 1, а затем вы могли бы использовать сводные таблицы для листов 2 и 3, чтобы показать отфильтрованные представления базовых данных