Excelmacros使用多个标准合并行

我正在与一个巨大的Excel工作表，我是一个总编程/macros新手。 我希望有人在那里可以给我看一个macros，可以帮助我，因为我在时间紧迫，我不知道如何手动完成这个。 电子表格包含与特定工作日的雇员退休金相关的交易数据。 我需要find一种方法来根据多个条件来合并行。 例如，如果Emp_ID和Trans_Type匹配，那么应该将Emp_Contrib和Empr_Contrib的数量相加，并删除多余的行，从而“合并”这些行。 此外，如果有Emp_ID匹配的行，并且有多个Trans_Type列的行，则应将相同的相似事务types合并在一起，并将Emp_Contrib和Empr_Contrib相加。

基本上，当事务types相同时，它应该为员工合并Emp_Contrib和Empr_Contrib。 如果员工有多个具有多个交易types的行，则合并相似的交易types。 我可能没有解释得很好，所以请看下面…

这里有一个BEFORE（当然是假数据）的例子…

Emp_ID PayDate Check_Num Trans_Type Fund_Desc Emp_Contrib Empr_Contrib 2222 1/30/2015 145511 5000 Retirement 300 0 2222 1/30/2015 145511 5000 Retirement 0 52.5 4444 1/30/2015 145522 6000 Roth 1894 0 4444 1/30/2015 145522 6000 Roth 0 52.5 4444 1/30/2015 145522 7000 457 1894 0 4444 1/30/2015 145522 7000 457 26.25 0 4444 1/30/2015 145522 8000 401K 100 0 4444 1/30/2015 145522 8000 401K 0 50 

这是我需要的后…

 Emp_ID PayDate Check_Num Trans_Type Fund_Desc Emp_Contrib Empr_Contrib 2222 1/30/2015 145511 5000 Retirement 300 52.5 4444 1/30/2015 145522 6000 Roth 1894 52.5 4444 1/30/2015 145522 7000 457 1920.25 0 4444 1/30/2015 145522 8000 401K 100 50 

在此先感谢您的帮助。

-克里斯

Answer 1

要获取唯一的行，请执行以下操作：

1. selectEmp_ID，PayDate，Check_Num，Trans_Type和Fund_Desc列
2. 转到数据选项卡 – >高级筛选器
3. 在“高级筛选器”对话框中，select“复制到其他位置”并选中“仅限唯一logging”checkbox
4. select某处复制独特的logging，我刚刚select了单元格I1

这是它的样子：

执行高级筛选后，这应该是这样的：

现在，您可以使用SUMIFS公式来获取添加和显示唯一行数据的数字。 使用我build议的位置（尽pipe您可以调整到您的首选位置）：

• 在单元格N2（for Emp_Contrib）中，使用此公式并复制下来： =SUMIFS(F:F,A:A,I2,B:B,J2,C:C,K2,D:D,L2,E:E,M2)
• 在单元格O2中（用于Empr_Contrib）使用此公式并复制下来： =SUMIFS(G:G,A:A,I2,B:B,J2,C:C,K2,D:D,L2,E:E,M2)

这应该提供您想要的结果。

Answer 2

这是一个macros来做到上述。

首先，插入一个类模块; 将其重命名为cContributions 。

然后，插入一个常规模块。

在常规模块中，调整工作表名称（wsSrc和wsRes）以反映您的真实工作表名称; 和rRes来反映你想要写结果的左上angular。

请注意，我们使用“员工ID”和“交易types”的组合来创build一个独特的密钥进行组合。 如果您的源表格包含多个date，而且您希望按date分隔，则只需将PayDate添加到该键即可。

类模块

 'RENAME Me cContributions Option Explicit Private pEmp_ID As String Private pPayDate As Date Private pCheck_Num As Long Private pTrans_Type As String Private pFund_Desc As String Private pEmp_Contrib As Currency Private pEmpr_Contrib As Currency Public Property Get Emp_ID() As String Emp_ID = pEmp_ID End Property Public Property Let Emp_ID(Value As String) pEmp_ID = Value End Property Public Property Get PayDate() As Date PayDate = pPayDate End Property Public Property Let PayDate(Value As Date) pPayDate = Value End Property Public Property Get Check_Num() As Long Check_Num = pCheck_Num End Property Public Property Let Check_Num(Value As Long) pCheck_Num = Value End Property Public Property Get Trans_Type() As String Trans_Type = pTrans_Type End Property Public Property Let Trans_Type(Value As String) pTrans_Type = Value End Property Public Property Get Fund_Desc() As String Fund_Desc = pFund_Desc End Property Public Property Let Fund_Desc(Value As String) pFund_Desc = Value End Property Public Property Get Emp_Contrib() As Currency Emp_Contrib = pEmp_Contrib End Property Public Property Let Emp_Contrib(Value As Currency) pEmp_Contrib = Value End Property Public Property Get Empr_Contrib() As Currency Empr_Contrib = pEmpr_Contrib End Property Public Property Let Empr_Contrib(Value As Currency) pEmpr_Contrib = Value End Property 

常规模块

 Option Explicit Sub CombineContributions() Dim cC As cContributions, colC As Collection Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range Dim vSrc As Variant, vRes() As Variant Dim I As Long Dim sKey As String Set wsSrc = Worksheets("Sheet1") Set wsRes = Worksheets("Sheet1") Set rRes = Range("I1") 'Get source data With wsSrc vSrc = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(COLUMNSIZE:=7) End With 'Collect data and combine as required Set colC = New Collection On Error Resume Next 'to detect combos For I = 2 To UBound(vSrc) 'skip the header row Set cC = New cContributions With cC .Emp_ID = vSrc(I, 1) .PayDate = vSrc(I, 2) .Check_Num = vSrc(I, 3) .Trans_Type = vSrc(I, 4) .Fund_Desc = vSrc(I, 5) .Emp_Contrib = vSrc(I, 6) .Empr_Contrib = vSrc(I, 7) 'create a key for uniqueness 'if there are multiple dates in the source data, could add PayDate to the key sKey = .Emp_ID & "|" & .Trans_Type colC.Add cC, sKey If Err.Number = 457 Then 'combine the data Err.Clear colC(sKey).Emp_Contrib = colC(sKey).Emp_Contrib + .Emp_Contrib colC(sKey).Empr_Contrib = colC(sKey).Empr_Contrib + .Empr_Contrib ElseIf Err.Number <> 0 Then Debug.Print Err.Number, Err.Description Stop 'tells what the error is, but not where it occurred End If End With Next I On Error GoTo 0 'create results array ReDim vRes(0 To colC.Count, 1 To UBound(vSrc, 2)) 'header row For I = 1 To UBound(vRes, 2) vRes(0, I) = vSrc(1, I) Next I 'data For I = 1 To colC.Count With colC(I) vRes(I, 1) = .Emp_ID vRes(I, 2) = .PayDate vRes(I, 3) = .Check_Num vRes(I, 4) = .Trans_Type vRes(I, 5) = .Fund_Desc vRes(I, 6) = .Emp_Contrib vRes(I, 7) = .Empr_Contrib End With Next I 'write and format the data Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2)) Application.ScreenUpdating = False With rRes .EntireColumn.Clear .Value = vRes 'added next line so the 457 would be left aligned. 'could instead explicitly make it text .Columns(5).HorizontalAlignment = xlLeft With .Rows(1) .HorizontalAlignment = xlCenter .Font.Bold = True End With .EntireColumn.AutoFit End With Application.ScreenUpdating = True End Sub 

---