请各位大神帮忙分类汇总问题

szdcp

菜鸟求助各位大神：


           借助某大神的程序进行分类汇总，将原竖型的数据汇总转成横型，格式正确但数据没汇总，请大神帮忙改改，谢谢！


Sub tt()
    Dim d As Object
    Dim arr, brr, i&, x&, y&
    arr = Sheet2.Range("A1").CurrentRegion
    ReDim brr(1 To UBound(arr), 1 To 2)
    Set d = CreateObject("Scripting.Dictionary")
    brr(1, 1) = [A1]
    x = 1: y = 1
    For i = 2 To UBound(arr)
        If Not d.Exists(arr(i, 1)) Then
            x = x + 1
            d(arr(i, 1)) = x
            brr(x, 1) = arr(i, 1)
        End If
        If Not d.Exists(arr(i, 2)) Then
            y = y + 1
            d(arr(i, 2)) = y
            If y > UBound(brr, 2) Then ReDim Preserve brr(1 To UBound(brr), 1 To y)
            brr(1, y) = arr(i, 2)
        End If
        
        brr(d(arr(i, 1)), d(arr(i, 2))) = arr(i, 5)
    Next
    Range("K1").Resize(x, y) = brr
    Set d = Nothing
End Sub



=>

shiruiqiang

字典嵌套吧，很容易解决

szdcp

shiruiqiang 发表于 2024-1-29 16:56
字典嵌套吧，很容易解决

菜鸟不会，这个程序也是依葫芦画瓢

limonet

关键字：TransForm

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL = "TransForm Sum(数量) Select 工厂 From [Sheet2$A:E] Where 分类<>'' Group By 工厂 Pivot 分类"
    Range("K2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

fzxba

brr(d(arr(i, 1)), d(arr(i, 2))) = brr(d(arr(i, 1)), d(arr(i, 2))) + arr(i, 5) ’很好，累加即可。

cjc209

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, dic As Object, iRSize&, iCSize&, iPosRow&, iPosCol
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    ReDim br(1 To UBound(ar), 1 To UBound(ar))
    br(1, 1) = "工厂": iRSize = 1: iCSize = 1
   
    For i = 2 To UBound(ar)
        If Not dic.exists(ar(i, 1)) Then
             iRSize = iRSize + 1
             dic(ar(i, 1)) = iRSize
             br(iRSize, 1) = ar(i, 1)
        End If
        If Not dic.exists(ar(i, 2)) Then
             iCSize = iCSize + 1
             dic(ar(i, 2)) = iCSize
             br(1, iCSize) = ar(i, 2)
        End If
        iPosRow = dic(ar(i, 1)): iPosCol = dic(ar(i, 2))
        br(iPosRow, iPosCol) = br(iPosRow, iPosCol) + ar(i, 5)
    Next i
   
    [K1].CurrentRegion.Clear
    With [K1].Resize(iRSize, iCSize)
        .Value = br
         .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

kittli

新手路过，仅供参考!