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

Question

В книге есть 3 листа: Sheet1, Sheet2, Sheet3. Лист1 имеет следующие данные:

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 

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

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

Answer 1

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

Answer 2

Вы можете использовать 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