VBA注满足条件的月汇总

158807837

日期<=J3 料号A4 第五列第7码<>W 第14列第三码<>R



Sub 返工()

Range("c4:j65536").ClearContents
Application.ScreenUpdating = False
Dim dc As Object, arr, brr(), k&, i&, a, b, z
Set dc = CreateObject("scripting.dictionary")
arr = Sheets("êy&#190;Y&#191;a").Range("a1").CurrentRegion
brr = Range("a3:k" & Range("a65536").End(3).Row)
ReDim crr(1 To UBound(arr), 1 To 12)

    For j = 3 To UBound(brr, 2) - 1
        dc(brr(1, j)) = j - 2
    Next j
    a = brr(2, 1) & brr(1, 11)
    For i = 2 To UBound(arr)
    If Mid(arr(i, 5), 7, 1) = "W" Then
   arr(i, 16) = 0
   End If
        z = arr(i, 2) & arr(i, 13)
        If dc.exists(arr(i, 1)) And z = a Then crr(3, dc(arr(i, 1))) = crr(3, dc(arr(i, 1))) + arr(i, 16)
       If Mid(arr(i, 14), 3, 1) = "R" Then
   arr(i, 16) = 0
   End If
        If dc.exists(arr(i, 1)) And z = a Then crr(2, dc(arr(i, 1))) = crr(2, dc(arr(i, 1))) + arr(i, 16)

    Next
[c4].Resize(3, 10) = crr
Application.ScreenUpdating = True
For k = 3 To 10
Cells(4, k) = Cells(6, k) - Cells(5, k)
If Cells(6, k) = 0 Then
Cells(7, k) = ""
Else
Cells(7, k) = Cells(4, k) / Cells(6, k)
End If
Cells(8, k) = Range("L1")
Next k
Range("A10") = Format(Range("J3"), "yyyy&#196;êmm&#212;&#194;ddè&#213;") & ",è&#235;&#191;a&#213;y3￡&#197;ú" & Range("J5") & "&#198;&#172;,&#214;&#216;1¤&#197;ú" & Range("J5") & "&#198;&#172;￡&#172;×ü&#188;&#198;" & Range("J6") & "&#198;&#172;;"
Range("A11") = Format(Range("J3"), "yyyy&#196;êmm&#212;&#194;ddè&#213;") & ",è&#235;&#191;a&#214;&#216;1¤&#197;ú±èày" & Format(Range("J7"), "0.00%")
Range("A12") = Format(Range("J3"), "yyyy&#196;êmm&#212;&#194;ddè&#213;") & ",±&#190;&#212;&#194;&#214;&#216;1¤&#197;ú×üè&#235;&#191;a" & Format(Range("J7"), "0.00%") & ",&#213;&#188;±&#190;&#212;&#194;è&#235;&#191;a×üá&#191;"
End Sub

158807837

求助中，谢谢。

wanao2008

日期<=J3 料号=A4 第五列第7码<>W 第14列第三码<>R
怎么一个结果也找不到？

wanao2008

找到了，我真笨！
日期<=J3 料号=A4 第五列第7码<>W 第14列第三码<>R 找到了 1324个
日期<=J3 料号=A4 第五列第7码<>W 第14列第三码=R 找到了 71个

wanao2008

不知对不对？

158807837

Sub leiJi()
    Dim arr, j1, j2, liaoHao
    rq = Range("b2")
    liaoHao = Range("A4")
    arr = Sheets("数据库").Range("a1").CurrentRegion
    For x = 2 To UBound(arr)
        If arr(x, 1) <= rq And arr(x, 2) = liaoHao And arr(x, 13) = Range("k3") Then
            'rr = Mid(Sheet1.Cells(x, 5), 7, 1)
            'ss = Mid(Sheet1.Cells(x, 14), 3, 1)
            If Mid(arr(x, 5), 7, 1) <> "W" And Mid(arr(x, 14), 3, 1) = "R" Then
                j1 = j1 + arr(x, 16)
            ElseIf Mid(arr(x, 5), 7, 1) <> "W" And Mid(arr(x, 14), 3, 1) <> "R" Then
                j2 = j2 + arr(x, 16)
            End If
            
        End If
    Next
    [l4] = j1
    [l5] = j2
    [l6] = j1 + j2
End Sub