请老师帮忙看下为什么求和为0呢

shxjgsh

Sub 统计()

Dim Rng As Range
Set Rng = Nothing
Dim j, sm As Long
Application.ScreenUpdating = False
sm = 0
For j = 2 To 70
    If Cells(j, 2) = Sheet4.Range("b" & j + 3) And Cells(j, 11) = Sheet4.Range("d4") Then
    sm = sm + Cells(j, 9)
    Sheet4.Range("d" & j + 3) = sm
    End If
    Next

End Sub

半百

没有附件，猜不到。

limonet

标准的sumifs,如果是练习，换个题目。
=SUMIFS(明细!$H:$H,明细!$B:$B,$B5,明细!$J:$J,C$4)

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, i&, j&, r&, dic As Object, strJoin$
   
    If [G1].Value = "" Then MsgBox "查询月份为空！": Exit Sub
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Sheets(1).[A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        strJoin = ar(i, 2) & Month(ar(i, 9)) & ar(i, 10)
        dic(strJoin) = dic(strJoin) + ar(i, 8)
        
    Next i
    r = Cells(Rows.Count, "B").End(xlUp).Row
    With Range("B4:F" & r)
        .Offset(1, 1).ClearContents
        ar = .Value
        For i = 2 To UBound(ar)
            For j = 2 To UBound(ar, 2) - 1
                strJoin = ar(i, 1) & [G1].Value & ar(1, j)
                ar(i, j) = dic(strJoin)
                ar(i, UBound(ar, 2)) = ar(i, UBound(ar, 2)) + ar(i, j)
            Next j
        Next i
        .Value = ar
    End With
   
    Set dic = Nothing
    Beep
End Sub

gwjkkkkk

参与一下。。。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.4.10
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("明细")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 10)
   
8.     End With
   
9.     st = Sheets("4月申领统计").[g1].Value
   
10.     For i = 2 To UBound(arr)
    
11.         If Month(arr(i, 9)) = st Then
    
12.             s = arr(i, 2) & "|" & arr(i, 10)
    
13.             d(s) = d(s) + arr(i, 8)
    
14.         End If
    
15.     Next
    
16.     With Sheets("4月申领统计")
    
17.         r = .Cells(.Rows.Count, "b").End(xlUp).Row
    
18.         arr = .[a1].Resize(r, 6)
    
19.         For i = 5 To UBound(arr)
    
20.             Sum = 0
    
21.             For j = 3 To 5
    
22.                 s = arr(i, 2) & "|" & arr(4, j)
    
23.                 If d.Exists(s) Then
    
24.                     arr(i, j) = d(s)
    
25.                 End If
    
26.                 Sum = Sum + arr(i, j)
    
27.             Next
    
28.             arr(i, 6) = Sum
    
29.         Next
    
30.         .[a1].Resize(r, 6) = arr
    
31.     End With
    
32.     Set d = Nothing
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "OK！"
    
35. End Sub
    

复制代码

ykcbf1100

你这个代码4月份的条件都没放进去。

shxjgsh

gwjkkkkk 发表于 2024-4-10 20:09
参与一下。。。

谢谢  做了修改 完全达到想要的效果！