[已解决]帮忙修改VBA代码

916445055

本表的要求是把2022.8表中G列满足8月定额表中A列、B列、C列的值得和按照2022.8中B列和J:AN列对应的日期填充在蓝色区域。

因8月定额满足A列、B列、C列3个条件的有多个，但是现在的VBA代码只能填充到一个里边，如何更改代码把所有的都填充上

比如：A18:C18中有两列是一样的，现在只能把求出来的只填充在一列里边，如何让两列都填充上

最佳答案

月排行榜 / 总排行榜

hasyh2008

2022-8-2 14:16

也发个熟悉的代码！！

Sub 汇总()
    Application.ScreenUpdating = False
    Dim Ar, R&, C%, K&, Str$, D As Object, D2 As Object, T
    T = Timer
    clear
    Set D = CreateObject("scripting.dictionary")
    Ar = Sheets("2022.8").[A1].CurrentRegion
    For R = 2 To UBound(Ar)
        Str = Ar(R, 4) & "|" & Ar(R, 5) & "|" & Ar(R, 6) & "|" & Ar(R, 2)
        D(Str) = D(Str) + Ar(R, 7)
    Next R
    With Sheets("8月定额")
        Ar = .[A1].CurrentRegion
        For R = 3 To UBound(Ar)
            For C = 10 To 40
                Str = Ar(R, 1) & "|" & Ar(R, 2) & "|" & Ar(R, 3) & "|" & Ar(2, C)
                If D.exists(Str) Then Ar(R, C) = D(Str)
                Ar(R, 41) = Ar(R, 41) + Ar(R, C)
            Next C
        Next R
        Sheets("8月定额").[A1].CurrentRegion = Ar
    End With
    MsgBox "用时：" & Format(Timer - T, "0.00\秒")
    Application.ScreenUpdating = True
End Sub
Sub clear()
    Sheets("8月定额").[J3:AN1000].ClearContents
End Sub

跳转到最佳答案楼层

hasyh2008

好熟悉的代码！

916445055

hasyh2008 发表于 2022-8-2 14:02
好熟悉的代码！

代码也是别人帮忙做的

hasyh2008

也发个熟悉的代码！！

Sub 汇总()
    Application.ScreenUpdating = False
    Dim Ar, R&, C%, K&, Str$, D As Object, D2 As Object, T
    T = Timer
    clear
    Set D = CreateObject("scripting.dictionary")
    Ar = Sheets("2022.8").[A1].CurrentRegion
    For R = 2 To UBound(Ar)
        Str = Ar(R, 4) & "|" & Ar(R, 5) & "|" & Ar(R, 6) & "|" & Ar(R, 2)
        D(Str) = D(Str) + Ar(R, 7)
    Next R
    With Sheets("8月定额")
        Ar = .[A1].CurrentRegion
        For R = 3 To UBound(Ar)
            For C = 10 To 40
                Str = Ar(R, 1) & "|" & Ar(R, 2) & "|" & Ar(R, 3) & "|" & Ar(2, C)
                If D.exists(Str) Then Ar(R, C) = D(Str)
                Ar(R, 41) = Ar(R, 41) + Ar(R, C)
            Next C
        Next R
        Sheets("8月定额").[A1].CurrentRegion = Ar
    End With
    MsgBox "用时：" & Format(Timer - T, "0.00\秒")
    Application.ScreenUpdating = True
End Sub
Sub clear()
    Sheets("8月定额").[J3:AN1000].ClearContents
End Sub

hasyh2008

！！！！！

916445055

hasyh2008 发表于 2022-8-2 14:16
也发个熟悉的代码！！

Sub 汇总()

谢谢，就是要的这效果

hasyh2008

916445055 发表于 2022-8-2 15:09
谢谢，就是要的这效果

认为行就选为最佳答案

我行我速2008

Sub clear()
    Sheets("8月定额").[J3:AN1000].ClearContents
End Sub

改为
Sub clear()
    Sheets("8月定额").[J3:AO1000].ClearContents
End Sub

916445055

我行我速2008 发表于 2022-8-3 20:54
Sub clear()
    Sheets("8月定额").[J3:AN1000].ClearContents
End Sub

谢谢