汇总

ddz79101

老师！我希望能根据代码的前四位分类汇总金额。请老师帮忙看看

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("K本费")
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         arr = .Range("a2:g" & r)
   
9.         For i = 1 To UBound(arr)
   
10.             xm = Left(arr(i, 5), 4)
    
11.             d(xm) = d(xm) + arr(i, 7)
    
12.         Next
    
13.         .Range("p2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
14.     End With
    
15. End Sub
    

复制代码

chxw68

简单问题。

ddz79101

chxw68 发表于 2024-4-15 16:50
简单问题。

谢谢老师！代码成功！还便于我拓宽。谢谢

limonet

关键字：left+group by

limonet

Sub limont()
    Dim Cn As Object, StrSQL$, Path$, FileName$
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL = "Select 代码,Sum(原币金额) From (Select Left(代码,4) as 代码,原币金额 From [K本费$E:G]) Group By 代码"
    Range("I2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

ddz79101

limonet 发表于 2024-4-15 17:35
Sub limont()
    Dim Cn As Object, StrSQL$, Path$, FileName$
    Set Cn = CreateObject("Adodb.Conn ...

谢谢老师！

jjmysjg

chxw68 发表于 2024-4-15 16:50
简单问题。

褚老师你好：
G、H、I三列求和，结果放到Q、R、S列,怎么修改代码

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, br, cr, i&, j&, r&, dic As Object, strKey$
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    r = Cells(Rows.Count, "A").End(xlUp).Row
    With Range("E1:I" & r)
        ar = .Value
        For i = 2 To UBound(ar)
            strKey = Left(ar(i, 1), 4)
            If Not dic.exists(strKey) Then
                br = .Cells(i, 2).Resize(, 4)
                br(1, 1) = strKey
                dic(strKey) = br
            Else
                br = dic(strKey)
                cr = .Cells(i, 2).Resize(, 4)
                For j = 2 To UBound(cr, 2)
                    br(1, j) = br(1, j) + cr(1, j)
                Next j
                dic(strKey) = br
            End If
        Next i
    End With
   
    Columns("U:X").Clear
    [U1].Resize(, 4) = Split("结果代码 借方金额 贷方金额 余额")
    [U2].Resize(dic.Count, 4) = Application.Rept(dic.items, 1)
    Set dic = Nothing
    Beep
End Sub

gwjkkkkk

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

借方是否模拟错了。。。