除了 SQL 和排序（之前已经提供）之外，我还给了它另一种方法。
我测试了这段代码，它可以工作。
这段代码背后的总体思路：
- 类模块“clsSheet”包含每张纸的所有信息，即。列标题 A、B、C，还有使用的范围、加载此范围的数组和最大行/列。
- 这些自创建的数据对象被加载到一个集合中，之后代码的下一部分将执行内存中的所有代码（快速）。
- 创建了一个字典，其中包含“模块名称”（即 module1、2、3 等）作为键，以及一个 clsModule 对象作为值。当键（因此模块名称）尚不存在时，将添加一个新项目。
- clsModule 类保存每个模块名称的信息，即。A、B 和 C 列信息。信息以数组的形式存储。
- 当所有信息都存储在字典中时，只需将字典内容翻译回首选形式即可。在这种情况下，我选择为每个工作表指定字典键的名称并将数据加载到相应的工作表中。
此代码包括：
- 动态查找名称为“A”、“B”和“C”的标头，从而降低错误风险；
- 快速执行；
- 创建一个新工作簿并将每个“模块”的值写入不同的工作表。
- 这些类可在其他情况下重复使用，只需进行最少的修改。
这种方法的主要好处是灵活性。由于您在框架中加载所有数据，因此您可以通过设置类并调用它们的属性来虚拟执行任何操作。
Sub GetModules()
Dim cSheet As clsSheet
Dim cModule As clsModule
Dim oSheet As Excel.Worksheet
Dim oColl_Sheets As Collection
Dim oDict As Object
Dim vTemp_Array_A As Variant
Dim vTemp_Array_B As Variant
Dim vTemp_Array_C As Variant
Dim lCol_A As Long
Dim lCol_B As Long
Dim lCol_C As Long
Dim lMax_Row As Long
Dim lMax_Col As Long
Dim oRange As Range
Dim oRange_A As Range
Dim oRange_B As Range
Dim oRange_C As Range
Dim vArray As Variant
Dim lCnt As Long
Dim lCnt_Modules As Long
Dim oBook As Excel.Workbook
Dim oSheet_Results As Excel.Worksheet
Set oColl_Sheets = New Collection
Set oDict = CreateObject("Scripting.Dictionary")
'Get number of columns, rows and headers A, B, C dynamically
'This is useful in case columns are inserted
For Each oSheet In ThisWorkbook.Sheets
Set cSheet = New clsSheet
Set cSheet = cSheet.get_Sheet_Data(cSheet, oSheet)
oColl_Sheets.Add cSheet
Next oSheet
'At this point, your entire sheet data structure is already contained in the collection oColl_Sheets
Set cSheet = Nothing
'Loop through the sheet objects and retrieve the values into modules
For Each cSheet In oColl_Sheets
'Now you load back all data from the sheet and perform loops in memory through the arrays
lCol_A = cSheet.fA_Col
lCol_B = cSheet.fB_Col
lCol_C = cSheet.fC_Col
lMax_Row = cSheet.fMax_Row
lMax_Col = cSheet.fMax_Col
Set oRange = cSheet.fRange
vArray = cSheet.fArray
For lCnt = 1 To lMax_Row - 1
'Check if the module already exists
If Not oDict.Exists(vArray(1 + lCnt, 1)) Then '+1 due to header
lCnt_Modules = lCnt_Modules + 1
Set cModule = New clsModule
'Add to dictionary when new module (thus key) is new
Set cModule = cModule.Add_To_Array_A(cModule, lCol_A, vArray(1 + lCnt, lCol_A), True)
Set cModule = cModule.Add_To_Array_B(cModule, lCol_B, vArray(1 + lCnt, lCol_B), True)
Set cModule = cModule.Add_To_Array_C(cModule, lCol_C, vArray(1 + lCnt, lCol_C), True)
oDict.Add vArray(1 + lCnt, 1), cModule
Else
Set cModule = oDict(vArray(1 + lCnt, 1))
'Replace when module (thus key) already exists
Set cModule = cModule.Add_To_Array_A(cModule, lCol_A, vArray(1 + lCnt, lCol_A), False)
Set cModule = cModule.Add_To_Array_B(cModule, lCol_A, vArray(1 + lCnt, lCol_B), False)
Set cModule = cModule.Add_To_Array_C(cModule, lCol_A, vArray(1 + lCnt, lCol_C), False)
Set oDict(vArray(1 + lCnt, 1)) = cModule
End If
Next lCnt
Next cSheet
'Now you have all the data available in your dictionary: per module (key), there is an array with the data you need.
'The only thing you have to do is open a new workbook and paste the data there.
'Below an example how you can paste the results per worksheet
Set oBook = Workbooks.Add
Set oSheet_Results = oBook.Sheets(1)
lCnt = 0
For lCnt = 0 To oDict.Count - 1
'Fill in values from dictionary
oBook.Sheets.Add().Name = oDict.Keys()(lCnt)
ReDim vTemp_Array_A(1 To UBound(oDict.Items()(lCnt).fA_Arr))
ReDim vTemp_Array_B(1 To UBound(oDict.Items()(lCnt).fB_Arr))
ReDim vTemp_Array_C(1 To UBound(oDict.Items()(lCnt).fC_Arr))
oBook.Sheets(oDict.Keys()(lCnt)).Range("A1").Value = "A"
oBook.Sheets(oDict.Keys()(lCnt)).Range("B1").Value = "B"
oBook.Sheets(oDict.Keys()(lCnt)).Range("C1").Value = "C"
vTemp_Array_A = oDict.Items()(lCnt).fA_Arr
vTemp_Array_B = oDict.Items()(lCnt).fB_Arr
vTemp_Array_C = oDict.Items()(lCnt).fC_Arr
Set oRange_A = oBook.Sheets(oDict.Keys()(lCnt)).Range(Cells(2, 1), Cells(1 + UBound(vTemp_Array_A), 1))
Set oRange_B = oBook.Sheets(oDict.Keys()(lCnt)).Range(Cells(2, 2), Cells(1 + UBound(vTemp_Array_B), 2))
Set oRange_C = oBook.Sheets(oDict.Keys()(lCnt)).Range(Cells(2, 3), Cells(1 + UBound(vTemp_Array_C), 3))
oRange_A = Application.Transpose(vTemp_Array_A)
oRange_B = Application.Transpose(vTemp_Array_B)
oRange_C = Application.Transpose(vTemp_Array_C)
Next lCnt
Set oColl_Sheets = Nothing
Set oRange = Nothing
Set oDict = Nothing
End Sub
名为“clsModule”的类模块
Option Explicit
Private pModule_Nr As Long
Private pA_Arr As Variant
Private pB_Arr As Variant
Private pC_Arr As Variant
Public Function Add_To_Array_A(cModule As clsModule, lCol As Long, vValue As Variant, bNew As Boolean) As clsModule
Dim vArray As Variant
vArray = cModule.fA_Arr
If bNew Then
ReDim vArray(1 To 1)
vArray(1) = vValue
Else
ReDim Preserve vArray(1 To UBound(vArray) + 1)
vArray(UBound(vArray)) = vValue
End If
cModule.fA_Arr = vArray
Set Add_To_Array_A = cModule
End Function
Public Function Add_To_Array_B(cModule As clsModule, lCol As Long, vValue As Variant, bNew As Boolean) As clsModule
Dim vArray As Variant
vArray = cModule.fB_Arr
If bNew Then
ReDim vArray(1 To 1)
vArray(1) = vValue
Else
ReDim Preserve vArray(1 To UBound(vArray) + 1)
vArray(UBound(vArray)) = vValue
End If
cModule.fB_Arr = vArray
Set Add_To_Array_B = cModule
End Function
Public Function Add_To_Array_C(cModule As clsModule, lCol As Long, vValue As Variant, bNew As Boolean) As clsModule
Dim vArray As Variant
vArray = cModule.fC_Arr
If bNew Then
ReDim vArray(1 To 1)
vArray(1) = vValue
Else
ReDim Preserve vArray(1 To UBound(vArray) + 1)
vArray(UBound(vArray)) = vValue
End If
cModule.fC_Arr = vArray
Set Add_To_Array_C = cModule
End Function
Property Get fModule_Nr() As Long
fModule_Nr = pModule_Nr
End Property
Property Let fModule_Nr(lModule_Nr As Long)
pModule_Nr = lModule_Nr
End Property
Property Get fA_Arr() As Variant
fA_Arr = pA_Arr
End Property
Property Let fA_Arr(vA_Arr As Variant)
pA_Arr = vA_Arr
End Property
Property Get fB_Arr() As Variant
fB_Arr = pB_Arr
End Property
Property Let fB_Arr(vB_Arr As Variant)
pB_Arr = vB_Arr
End Property
Property Get fC_Arr() As Variant
fC_Arr = pC_Arr
End Property
Property Let fC_Arr(vC_Arr As Variant)
pC_Arr = vC_Arr
End Property
名为“clsSheet”的类模块
Option Explicit
Private pMax_Col As Long
Private pMax_Row As Long
Private pArray As Variant
Private pRange As Range
Private pA_Col As Long
Private pB_Col As Long
Private pC_Col As Long
Public Function get_Sheet_Data(cSheet As clsSheet, oSheet As Excel.Worksheet) As clsSheet
Dim oUsed_Range As Range
Dim lLast_Col As Long
Dim lLast_Row As Long
Dim iCnt As Integer
Dim vArray As Variant
Dim lNr_Rows As Long
Dim lNr_Cols As Long
Dim lCnt As Long
With oSheet
lLast_Row = .Cells(.Rows.Count, "A").End(xlUp).Row
lLast_Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
oSheet.Activate
Set oUsed_Range = oSheet.Range(Cells(1, 1), Cells(lLast_Row, lLast_Col))
cSheet.fRange = oUsed_Range
lNr_Rows = oUsed_Range.Rows.Count
cSheet.fMax_Row = lNr_Rows
lNr_Cols = oUsed_Range.Columns.Count
cSheet.fMax_Col = lNr_Cols
ReDim vArray(1 To lNr_Rows, 1 To lNr_Cols)
vArray = oUsed_Range
cSheet.fArray = vArray
For lCnt = 1 To lNr_Cols
Select Case vArray(1, lCnt)
Case "A"
cSheet.fA_Col = lCnt
Case "B"
cSheet.fB_Col = lCnt
Case "C"
cSheet.fC_Col = lCnt
End Select
Next lCnt
Set get_Sheet_Data = cSheet
End Function
Property Get fMax_Col() As Long
fMax_Col = pMax_Col
End Property
Property Let fMax_Col(lMax_Col As Long)
pMax_Col = lMax_Col
End Property
Property Get fMax_Row() As Long
fMax_Row = pMax_Row
End Property
Property Let fMax_Row(lMax_Row As Long)
pMax_Row = lMax_Row
End Property
Property Get fRange() As Range
Set fRange = pRange
End Property
Property Let fRange(oRange As Range)
Set pRange = oRange
End Property
Property Get fArray() As Variant
fArray = pArray
End Property
Property Let fArray(vArray As Variant)
pArray = vArray
End Property
Property Get fA_Col() As Long
fA_Col = pA_Col
End Property
Property Let fA_Col(lA_Col As Long)
pA_Col = lA_Col
End Property
Property Get fB_Col() As Long
fB_Col = pB_Col
End Property
Property Let fB_Col(lB_Col As Long)
pB_Col = lB_Col
End Property
Property Get fC_Col() As Long
fC_Col = pC_Col
End Property
Property Let fC_Col(lC_Col As Long)
pC_Col = lC_Col
End Property