Excelmacros – 迭代地将行从一个表单复制到另一个表单

在工作簿中有3张:Sheet1,Sheet2,Sheet3。 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具有存在于Sheet1中的“GroupB”的所有行,使用macros子程序?

编辑:
我希望使用散列表types的结构来存储GroupA,GroupB等等的值,并相应地对每个组进行迭代地处理sheet1。

你可以使用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 

你必须坚持已经桌子的风格? 我认为如果将组包含在sheet1的额外列中,然后可以使用数据透视表来显示表2和3以显示基础数据的过滤视图