求数量累加的代码怎么写

zhongjingquan

各位老师好，最近遇到一个问题，在Excel中做个简单录入汇总表，sheet1为登记页，sheet2为汇总表，当有人领取物品时，sheet1选择人员并录入所领物品数量，然后汇总到sheet2中，在sheet2汇总表有个条件，如果汇总表中领取人重名的话，在重名下数量累加，如果领取人与汇总表不重名，则在后一列输入。我自己琢磨了一下，自己的思路是这样的，首先是找到汇总表最后一列，然后如果汇总表最后一列是1的话，则将sheet1数字直接复制到汇总表上，后面再有汇总的话就开始循环查找有没有重名，如有重名则累加，如果没有则向后一列复制，但是不知道这个思路对不对，而且自己也不会写，只能向各位老师求教，麻烦各位老师指点一下。

tanglf188

人名在列物品在行？

3190496160

Sub 录入()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a2:b" & rs)
End With

With Sheets("sheet2")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(2, Columns.Count).End(xlToLeft).Column
    If r = 1 And y = 1 Then
        mm = ar(1, 2)
        .[a2].Resize(UBound(ar), UBound(ar, 2)) = ar
    Else
        br = .Range(.Cells(2, 1), .Cells(r, y + 1))
        For j = 2 To UBound(br, 2)
            If Trim(br(1, j)) <> "" Then
                d(Trim(br(1, j))) = j
            End If
        Next j
        For i = 2 To UBound(br, 1)
            If Trim(br(i, 1)) <> "" Then
                d(Trim(br(i, 1))) = i
            End If
        Next i
        lh = d(Trim(ar(1, 2)))
        If lh = "" Then
            lh = y + 1
        Else
            lh = lh
        End If
        br(1, lh) = ar(1, 2)
        For i = 2 To UBound(ar, 1)
            If Trim(ar(i, 2)) <> "" Then
                If IsNumeric(ar(i, 2)) Then
                    xh = d(Trim(ar(i, 1)))
                    If xh <> "" Then
                        br(xh, lh) = br(xh, lh) + ar(i, 2)
                    End If
                End If
            End If
        Next i
        .Range(.Cells(2, 1), .Cells(r, y + 1)) = br
    End If
End With
Set d = Nothing
MsgBox "ok!"
End Sub

3190496160

汇总表12-9.rar (21.33 KB, 下载次数: 7)

2022-12-9 09:55 上传

点击文件名下载附件

zhongjingquan

感谢老师，感谢感谢~