保存数据到指定区域并累加数据

1105263341

请老师帮忙写段代码实现指定区域保存数据并累加,谢谢

在指定区域录入数据后,需要把录入的数据保存到指定区域,如果数据相同则累加  反之则保存到新行,由于自己vba代码不精通,特到论坛求助各位老师.还请老师帮忙解决一下.谢谢 保存到指定区域并累加.rar (10.7 KB, 下载次数: 6)

2023-2-16 16:31 上传

点击文件名下载附件

蓝桥玄霜

保存的例子：

1105263341

蓝桥玄霜 发表于 2023-2-16 19:07
保存的例子：

谢谢蓝桥玄霜老师,我照着代码先理解一下.谢谢啦

1105263341

蓝桥玄霜 发表于 2023-2-16 19:07
保存的例子：

蓝桥玄霜老师您好,代码运行了后  如果"当月第几周"和"季节"数据一样的 就累加对应的数量和金额还不能实现.
我也找不到修改的方法 请问能否请您再帮我修改一下? 打扰您啦,实在是不好意思



Sub 矩形圆角1_Click()

Dim dq, Arr, i%, zs, rq, d, x$, m%, n%, sL, je
Dim k, t, aa, j%
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
Arr = [b19].CurrentRegion
dq = Arr(2, 5)
zs = Arr(4, 1): rq = Arr(5, 1)
For i = 4 To UBound(Arr)
    x = Arr(i, 2) & Arr(i, 3)
    d(x) = d(x) & i & ","
Next
k = d.keys: t = d.items
For i = 0 To UBound(k)
    t(i) = Left(t(i), Len(t(i)) - 1)
   
    If InStr(t(i), ",") Then
        sL = 0: je = 0
        aa = Split(t(i), ",")
        For j = 0 To UBound(aa)
            sL = sL + Arr(aa(j), 4): je = je + Arr(aa(j), 5)
        Next
        
        With Sheet2
            m = .Cells(Rows.Count, 2).End(x1Up).Row + 1
            
            .Cells(m, 2) = zs: .Cells(m, 3) = rq

            .Cells(m, 4) = k(i): .Cells(m, 5) = sL: .Cells(m, 6) = je
            
            n = .Cells(Rows.Count, 15).End(x1Up).Row + 1
            .Cells(n, 15) = dq: .Cells(n, 16) = zs
            .Cells(n, 17) = k(i): .Cells(n, 18) = sL: .Cells(n, 19) = je
        End With
    Else
        With Sheet2
            m = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
            .Cells(m, 2) = zs: .Cells(m, 3) = rq
            .Cells(m, 4) = k(i): .Cells(m, 5) = Arr(t(i), 4): .Cells(m, 6) = Arr(t(i), 5)
            n = .Cells(Rows.Count, 15).End(xlUp).Row + 1
            .Cells(n, 15) = dq: .Cells(n, 16) = zs
            .Cells(n, 17) = k(i): .Cells(n, 18) = Arr(t(i), 4): .Cells(n, 19) = Arr(t(i), 5)
        End With
    End If
Next
End Sub