求助：VBA数据汇总（行、列都有变量）

放逐理想

老师，您好!
         我的文件中一共有两个表
         1、数据源表-数据来源
         2、男段-数据获取后存储表
     我需要汇总符合'“男段”表中 3列PO#  、4列Gender Description 、5列style 和12-31列码数，到“数据源表“中求和各码数的数量。      
    请老师帮忙看下那些出现问题了，汇总不出来，以下是我写的代码，谢谢。
Sub 订单码数求和()
    Application.ScreenUpdating = False
    Dim d As Object
    Dim arr, brr
    Dim a, X, Y As Integer
     arr = ThisWorkbook.Sheets("数据源").Range("A3:AL" & ThisWorkbook.Sheets("数据源").Range("C" & Cells.Rows.Count).End(xlUp).Row)
     brr = ThisWorkbook.Sheets("男段").Range("A2:AE" & ThisWorkbook.Sheets("男段").Range("C" & Cells.Rows.Count).End(xlUp).Row)
     Set d = CreateObject("scripting.dictionary")
     
     For a = 1 To UBound(arr)
        s = arr(a, 3) & arr(a, 8) & arr(a, 10)  '订单号+段别+型体-配色代码
        d(s) = d(s) + arr(a, 5)
     Next
     
     For X = 2 To UBound(brr)
        For Y = 12 To 31
        s = brr(X, 3) & brr(X, 4) & brr(X, 5) & "-" & brr(2, Y)
        brr(X, Y) = d(s)
        Next Y
    Next X
  ThisWorkbook.Sheets("男段").Range("A2").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

唐朝123

数据源的C列是文本，要转换，另外brr数组有点问题，重新帮你修改一下代码，你试一下：
Sub 合并()

    Set d = CreateObject("scripting.dictionary")
    With Sheets("数据源")
        arr = .Range("a2:al" & .Cells(Rows.Count, 3).End(xlUp).Row)
        For i = 1 To UBound(arr)
            d(CStr(arr(i, 3)) & "-" & arr(i, 8) & "-" & arr(i, 10)) = d(CStr(arr(i, 3)) & "-" & arr(i, 8) & "-" & arr(i, 10)) + arr(i, 5)
        Next i
    End With
   
    With Sheets("男段")
    brr = .Range("a3:e" & .Cells(Rows.Count, 1).End(xlUp).Row)
    ReDim crr(1 To UBound(brr), 1 To 20)
    For i = 1 To UBound(brr)
        For k = 4 To 23
          crr(i, k - 3) = d(CStr(brr(i, 3)) & "-" & brr(i, 4) & "-" & brr(i, 5) & "-" & "M" & k)
        Next k
    Next
    .[k3].Resize(UBound(brr), 20) = crr
    End With
End Sub

放逐理想

唐朝123 发表于 2019-3-14 14:16
数据源的C列是文本，要转换，另外brr数组有点问题，重新帮你修改一下代码，你试一下：
Sub 合并()

老师，您好，感谢您的帮助，还有点问题：
crr(i, k - 3) = d(CStr(brr(i, 3)) & "-" & brr(i, 4) & "-" & brr(i, 5) & "-" & "M" & k)
这句"M" & k ，也有可能是J& k 或C& k 或CkCK+1，所以这当我的码数变化的时候就有问题了，能否再帮忙改成适用各种码的？
以上，谢谢。

唐朝123

放逐理想 发表于 2019-3-14 16:08
老师，您好，感谢您的帮助，还有点问题：
crr(i, k - 3) = d(CStr(brr(i, 3)) & "-" & brr(i, 4) & "-"  ...

按照你的要求重新修改了，用单元格内的型号来统计，同时修改了一下之前的小差错，贴错了一列。
Sub 合并()

    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    With Sheets("数据源")
        arr = .Range("a2:al" & .Cells(Rows.Count, 3).End(xlUp).Row)
        For i = 1 To UBound(arr)
            d(CStr(arr(i, 3)) & "-" & arr(i, 8) & "-" & arr(i, 10)) = d(CStr(arr(i, 3)) & "-" & arr(i, 8) & "-" & arr(i, 10)) + arr(i, 5)
        Next i
    End With
    With Sheets("男段")
    brr = .Range("a3:e" & .Cells(Rows.Count, 1).End(xlUp).Row)
    ReDim crr(1 To UBound(brr), 1 To 20)
    For i = 1 To UBound(brr)
        For k = 4 To 23
          crr(i, k - 3) = d(CStr(brr(i, 3)) & "-" & brr(i, 4) & "-" & brr(i, 5) & "-" & .Cells(2, k + 8).Value)
        Next k
    Next
    .[L3].Resize(UBound(brr), 20) = crr
    End With
    Application.ScreenUpdating = True
End Sub

放逐理想

唐朝123 发表于 2019-3-14 18:59
按照你的要求重新修改了，用单元格内的型号来统计，同时修改了一下之前的小差错，贴错了一列。
Sub 合并 ...

老师，非常感谢您的帮助，已经完美解决，谢谢。