汇总

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.15
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     k = Application.InputBox("请输入汇总代码位数", "默认是4位", "5601")
   
4.     With Sheets("K本费")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 7)
   
7.         ReDim brr(1 To UBound(arr), 1 To 2)
   
8.         
   
9.         For i = 2 To UBound(arr)
   
10.             s = CStr(arr(i, 5))
    
11.             If Left(CStr(arr(i, 5)), 4) = k Then
    
12.                 d(s) = d(s) + arr(i, 7)
    
13.             End If
    
14.         Next
    
15.         .[m5:n10000] = ""
    
16.         .Columns("m:m").NumberFormatLocal = "@"
    
17.         .[m5].Resize(d.Count, 2) = WorksheetFunction.Transpose(Array(d.keys, d.Items))
    
18.     End With
    
19.     MsgBox "OK！"
    
20. End Sub
    

复制代码

jjmysjg

gwjkkkkk 发表于 2024-4-15 19:44
借方是否模拟错了。。。

是模拟错了，多谢指点

chxw68

jjmysjg 发表于 2024-4-15 19:12
褚老师你好：
G、H、I三列求和，结果放到Q、R、S列,怎么修改代码

修改好了。

ddz79101

gwjkkkkk 发表于 2024-4-15 19:44
借方是否模拟错了。。。

谢谢老师！代码运行成功

ddz79101

ykcbf1100 发表于 2024-4-15 19:50
附件供参考。。。

谢谢老师！代码运行成功！谢谢给另种思路—个别确认

ddz79101

chxw68 发表于 2024-4-15 20:22
修改好了。

谢谢老师！代码运行成功！花明日献上

ddz79101

gwjkkkkk 发表于 2024-4-15 19:44
借方是否模拟错了。。。

老师！花明日献上

huarong7984

可自主指定汇总代码位数的金额，仅供参考：

Sub 汇总指定位数代码的金额()
  Dim i As Long
  Dim arr As Variant
  Dim je As String
  Dim d As Object
  Dim totalAmounts As Double
  Dim code As String
  Range("R:S").Clear                                                  '清除R:S列所有数据及格式
  Set d = CreateObject("scripting.dictionary")
  With Worksheets("K本费")
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:G" & lastRow).Value
    n = Cells(2, "P")                                                   '将P2单元格的值（即设定的汇总代码位数）赋给n
    For i = 1 To UBound(arr)
      If Len(arr(i, 5)) >= n Then                                  '只处理指定位数及以上的代码
        je = Left(arr(i, 5), n)                                         '撮取指定位数代码
        totalAmounts = 0
        code = ""
        If Not d.Exists(je) Then
          d.Add je, totalAmounts
        End If
          d(je) = d(je) + arr(i, 7)                                   '对指定位数代码的金额进行汇总
      End If
    Next i
    With .Range("R2").Resize(d.Count, 2)
      .Value = Application.Transpose(Array(d.Keys, d.Items))
      .NumberFormat = "@"
      .Offset(-1, 0).Resize(1, 2).Value = Array("代码", "原币金额码")
      .Parent.Columns("R:S").AutoFit
      .Parent.Rows.AutoFit
      .Parent.Range("R1:S1").Font.Bold = True
    End With
    [R1].CurrentRegion.Borders.LineStyle = xlContinuous
    Range("R1:S1").HorizontalAlignment = xlCenter
    .Columns("S").NumberFormat = "0.00"
    Range("R1:S1").Interior.Color = RGB(223, 235, 253)
  End With
End Sub

huarong7984

所发示例，可自主选择汇总的代码位数，仅供参考