VBA Excel基于匹配列单元格查找和合并行

我试图找到一种方法，根据vba excel中两个特定列中的值来组合行。 例如： 假设我有以下表格：

Column A   Column J   Column Z
    1         A          ?
    1         A          !
    2         B          ?
    2         B          !

我需要把它转换成：

Column A   Column J   Column Z
    1         A         ?, !
    2         B         ?, !

---

这是假设列J是键，不需要追加列A。如果A列也需要组合（并不总是相同的），您只需为每个循环添加另一个，以检查数据是否存在，如果不存在，则添加数据，就像代码中的第26列一样

Sub CombineData()

    x = 2
    Do Until Cells(x, 1) = "" 'loop through every row in sheet starting at 2 (1 will never be removed, since it is the first data)
        x2 = 1
        Do Until x2 = x
            If Cells(x, 10) = Cells(x2, 10) Then 'this is comparing column J.  If another column is the reference then change 10 to the column number

                splt = Split(Cells(x, 26), ", ")
                For Each s In splt 'check to see if data already in column z
                    If s = Cells(x2, 26) Then GoTo alreadyEntered
                Next

                Cells(x, 26) = Cells(x, 26) & ", " & Cells(x2, 26) 'append column z data to row x
alreadyEntered:
                Rows(x2).Delete Shift:=xlUp 'delete duplicate row
                x = x - 1 'to keep x at same row, since we just removed a row
                Exit Do
            Else
                x2 = x2 + 1
            End If

        Loop

        x = x + 1
    Loop

End Sub

---

这里有另一种方法，使用用户定义的类型和集合迭代列表并生成组合结果。对于大型数据集，它应该比读取工作表上的每个单元格快得多

我假设您在J列上分组，并且A列数据不需要在单元格中串联。如果是这样的话，对例程的修改将是微不足道的

首先，插入一个类模块，将其重命名为CombData，并在该模块中插入以下代码：

Option Explicit
Private pColA As String
Private pColJ As String
Private pColZConcat As String

Public Property Get ColA() As String
    ColA = pColA
End Property
Public Property Let ColA(Value As String)
    pColA = Value
End Property

Public Property Get ColJ() As String
    ColJ = pColJ
End Property
Public Property Let ColJ(Value As String)
    pColJ = Value
End Property

Public Property Get ColZConcat() As String
    ColZConcat = pColZConcat
End Property
Public Property Let ColZConcat(Value As String)
    pColZConcat = Value
End Property

然后插入常规模块并插入以下代码：

Option Explicit
Sub CombineData()
    Dim cCombData As CombData
    Dim colCombData As Collection
    Dim V As Variant
    Dim vRes() As Variant 'Results Array
    Dim rRes As Range   'Location of results
    Dim I As Long

'read source data into array
V = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=26)

'Set results range.  Here it is set below the Source Data
'Could be anyplace, even on a different worksheet; or could overlay the
'  original.  Area below and to right is cleared

Set rRes = Range("A1").Offset(UBound(V) + 10)
Range(rRes, rRes.SpecialCells(xlCellTypeLastCell)).Clear

Set colCombData = New Collection
On Error Resume Next
For I = 1 To UBound(V)
    Set cCombData = New CombData
    cCombData.ColA = V(I, 1)
    cCombData.ColJ = V(I, 10)
    cCombData.ColZConcat = V(I, 26)
    colCombData.Add cCombData, CStr(cCombData.ColJ)
    If Err.Number <> 0 Then
        Err.Clear
        With colCombData(cCombData.ColJ)
            .ColZConcat = .ColZConcat & ", " & V(I, 26)
        End With
    End If
Next I
On Error GoTo 0

ReDim vRes(1 To colCombData.Count, 1 To 26)
For I = 1 To UBound(vRes)
    With colCombData(I)
        vRes(I, 1) = .ColA
        vRes(I, 10) = .ColJ
        vRes(I, 26) = .ColZConcat
    End With
Next I

rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes

End Sub

选项显式
子组合数据（）
Dim cCombData作为组合数据
Dim Colcomb数据作为收集
Dim V作为变体
Dim vRes（）作为变量的结果数组
将RRE作为结果的范围位置
我想我会坚持多久
'将源数据读入数组
V=范围（“A1”，单元格（行数，“A”）。结束（xlUp））。调整大小（列大小：=26）
'设置结果范围。在这里，它设置在源数据下面
“可能在任何地方，甚至在不同的工作表上；或者可以覆盖
“原版。下方和右侧区域已清除
设置rRes=范围（“A1”）。偏移量（UBound（V）+10）
范围（rRes，rRes.SpecialCells（xlCellTypeLastCell））。清除
Set colCombData=新集合
出错时继续下一步
对于I=1至UBound（V）
设置cCombData=新CombData
cCombData.ColA=V（I，1）
cCombData.ColJ=V（I，10）
cCombData.ColZConcat=V（I，26）
添加cCombData，CStr（cCombData.ColJ）
如果错误号为0，则
呃，明白了
使用colCombData（cCombData.ColJ）
.ColZConcat=.ColZConcat&“，”&V（I，26）
以
如果结束
接下来我
错误转到0
ReDim vRes（1到colCombData.Count，1到26）
对于I=1至UBound（vRes）
使用colCombData（I）
vRes（I，1）=.可乐
vRes（I，10）=.ColJ
vRes（I，26）=.ColZConcat
以
接下来我
重新调整大小（UBound（vRes，1），UBound（vRes，2））=vRes
端接头

编辑：注意，源数据被读入变量数组V。如果在“监视”窗口中检查V，您将看到第一个维度表示行；第二个维度是柱。因此，例如，如果希望在不同的列集合上执行相同的过程，只需在读取set cCombData=New CombData的行下更改对第二个维度的引用。例如，B列数据将是V（I，2），依此类推。当然，您可能希望重命名数据类型，使它们更能代表您正在做的事情

此外，如果您的数据从第2行开始，只需使用I=2而不是I=1通过V开始迭代即可

EDIT2:为了既覆盖原始内容，又保留未处理列的内容，以下修改将对A、J和Z列执行。您应该能够对选择处理的任何列进行修改

Option Explicit
Sub CombineData()
    Dim cCombData As CombData
    Dim colCombData As Collection
    Dim V As Variant
    Dim vRes() As Variant 'Results Array
    Dim rRes As Range   'Location of results
    Dim I As Long, J As Long, K As Long

'read source data into array
V = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=26)

'Set results range.  Here it is set below the Source Data
'Could be anyplace, even on a different worksheet; or could overlay the
'  original.  Area below and to right is cleared

Set rRes = Range("A1")  '.Offset(UBound(V) + 10)
Range(rRes, rRes.SpecialCells(xlCellTypeLastCell)).Clear

Set colCombData = New Collection
On Error Resume Next
For I = 1 To UBound(V)
    Set cCombData = New CombData
    cCombData.ColA = V(I, 1)
    cCombData.ColJ = V(I, 10)
    cCombData.ColZConcat = V(I, 26)
    colCombData.Add cCombData, CStr(cCombData.ColJ)
    If Err.Number <> 0 Then
        Err.Clear
        With colCombData(cCombData.ColJ)
            .ColZConcat = .ColZConcat & ", " & V(I, 26)
        End With
    End If
Next I
On Error GoTo 0

ReDim vRes(1 To colCombData.Count, 1 To 26)
For I = 1 To UBound(vRes)
    With colCombData(I)
        vRes(I, 1) = .ColA
        vRes(I, 10) = .ColJ
        vRes(I, 26) = .ColZConcat

        'Note the 10 below is the column we are summarizing by
        J = WorksheetFunction.Match(.ColJ, WorksheetFunction.Index(V, 0, 10), 0)
        For K = 1 To 26
            Select Case K  'Decide which columns to copy over
                Case 2 To 9, 11 To 25
                    vRes(I, K) = V(J, K)
            End Select
        Next K
    End With
Next I

rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes

End Sub

选项显式
子组合数据（）
Dim cCombData作为组合数据
Dim Colcomb数据作为收集
Dim V作为变体
Dim vRes（）作为变量的结果数组
将RRE作为结果的范围位置
我长，J长，K长
'将源数据读入数组
V=范围（“A1”，单元格（行数，“A”）。结束（xlUp））。调整大小（列大小：=26）
'设置结果范围。在这里，它设置在源数据下面
“可能在任何地方，甚至在不同的工作表上；或者可以覆盖
“原版。下方和右侧区域已清除
设置rRes=范围（“A1”）。偏移量（UBound（V）+10）
范围（rRes，rRes.SpecialCells（xlCellTypeLastCell））。清除
Set colCombData=新集合
出错时继续下一步
对于I=1至UBound（V）
设置cCombData=新CombData
cCombData.ColA=V（I，1）
cCombData.ColJ=V（I，10）
cCombData.ColZConcat=V（I，26）
添加cCombData，CStr（cCombData.ColJ）
如果错误号为0，则
呃，明白了
使用colCombData（cCombData.ColJ）
.ColZConcat=.ColZConcat&“，”&V（I，26）
以
如果结束
接下来我
错误转到0
ReDim vRes（1到colCombData.Count，1到26）
对于I=1至UBound（vRes）
使用colCombData（I）
vRes（I，1）=.可乐
vRes（I，10）=.ColJ
vRes（I，26）=.ColZConcat
请注意，下面的10条是我们总结的专栏
J=WorksheetFunction.Match（.ColJ，WorksheetFunction.Index（V，0，10），0）
对于K=1到26
选择案例K'决定要复制的列
案例2至9、11至25
vRes（I，K）=V（J，K）
结束选择
下一个K
以
接下来我
重新调整大小（UBound（vRes，1），UBound（vRes，2））=vRes
端接头

您可能需要一个透视表：splt和s是范围数据类型吗？splt和s只是变量。当我拆分某个数组时，如果它将立即被使用，我总是使用splt来包含该数组，当它不需要在多个位置使用时，我总是使用s来表示字符串变量。对不起，我对VBA还是很陌生。你说的“只是变量”是什么意思？我得到一个关于未定义这些变量的编译器错误。您必须选择option explicit。在子的开始，只需添加线-暗s，sptthanks，这看起来像我要找的！还有一个问题，我有另一张纸，我想用同样的方法，但是列是不同的。对于B、J和R列，我分别需要更改哪些内容。艾尔