Excel宏 - 迭代地将行从一个工作表复制到另一个工作表

2 回答

• 0

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

  回复于 2024-04-29T22:29:41+08:00
• 3

  你必须坚持有 table 风格吗？我认为如果你将这个组包含在sheet1的额外列中然后你可以使用数据表2和3的数据透视表来显示基础数据的过滤视图会更容易

  回复于 2024-04-29T22:29:41+08:00