如何利用VBA按照字段批量提取工作表中的信息填入指定的工作表中

1. 按照表1中的关键字段提取内容
   2、将表1中提取的内容填入相应的表2中(注:表1，表2的表头是不一致的)
   3、是批量生成相应的表

可以使用VBA编写一个宏来按照指定字段批量提取工作表中的信息，并将提取的内容填入指定的工作表中。下面是一个简单的示例代码：

Sub ExtractData()
    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim rngSrc As Range, rngDest As Range
    Dim cel As Range, celHeader As Range
    Dim lastRow As Long, i As Long
    Dim dict As Object
    
    ' 设置源表和目标表
    Set wsSrc = ThisWorkbook.Sheets("表1")
    Set wsDest = ThisWorkbook.Sheets("表2")
    
    ' 获取源表的数据范围
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
    Set rngSrc = wsSrc.Range("A1:F" & lastRow)
    
    ' 获取目标表的表头范围
    Set celHeader = wsDest.Range("A1")
    
    ' 创建字典来存储提取的数据
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历源表的每一行数据
    For i = 2 To lastRow
        Set cel = rngSrc.Cells(i, "B") ' 根据关键字段提取数据
        If Not dict.Exists(cel.Value) Then
            ' 如果字典中不存在该关键字段，则创建一个新的项
            dict(cel.Value) = New Collection
        End If
        
        ' 将该行数据添加到关键字段对应的集合中
        dict(cel.Value).Add rngSrc.Rows(i).Value
    Next i
    
    ' 遍历目标表的每个表头单元格，并按照关键字段提取对应的数据
    For Each celHeader In wsDest.Range("A1:F1").Cells
        If dict.Exists(celHeader.Value) Then
            ' 如果字典中存在该关键字段，则将对应的数据填入目标表
            Set rngDest = celHeader.Offset(1, 0).Resize(dict(celHeader.Value).Count, rngSrc.Columns.Count)
            rngDest.Value = CollectionToArray(dict(celHeader.Value))
        End If
    Next celHeader
End Sub

Function CollectionToArray(col As Collection) As Variant()
    Dim arr() As Variant
    Dim i As Long
    
    ReDim arr(1 To col.Count, 1 To col(1).Count)
    
    For i = 1 To col.Count
        arr(i, 1) = col(i)(1)
        arr(i, 2) = col(i)(2)
        arr(i, 3) = col(i)(3)
        arr(i, 4) = col(i)(4)
        arr(i, 5) = col(i)(5)
        arr(i, 6) = col(i)(6)
    Next i
    
    CollectionToArray = arr
End Function

答案来自 我点评开发社区 https://www.wodianping.com/
此宏将根据表1中的“B”列中的关键字段提取数据，并将提取的数据填入表2中相应的表头中。请根据实际情况修改代码中的工作表名称和列号。