求助 各位老铁 帮忙编剧报表中的代码，谢谢

我就是我2020

报表中的仓库  使用vba代码   分类1   分类2    相当于透视选择需要的数据一样    附上报表   学习.zip (15.03 KB, 下载次数: 19)

2020-7-8 17:55 上传

点击文件名下载附件

老骥705664849

Sub 分类()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Dim br(), cr()
ar = Sheets("仓库").[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To 3)
ReDim cr(1 To UBound(ar), 1 To 3)
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        t = d(Trim(ar(i, 1)))
        If t = "" Then
            k = k + 1
             d(Trim(ar(i, 1))) = k
             t = k
             br(k, 1) = ar(i, 1)
             br(k, 2) = ar(i, 2)
        End If
        br(t, 3) = br(t, 3) + ar(i, 3)
    End If

    If Trim(ar(i, 4)) <> "" Then
        tk = d(Trim(ar(i, 4)))
        If tk = "" Then
            kk = kk + 1
             d(Trim(ar(i, 4))) = kk
             tk = kk
             cr(kk, 1) = ar(i, 1)
             cr(kk, 2) = ar(i, 2)
        End If
        cr(tk, 3) = cr(tk, 3) + ar(i, 3)
    End If
   
Next i
With Sheets("分类1")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(k, 3) = br
End With
With Sheets("分类2")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(kk, 3) = cr
End With
            
End Sub

老骥705664849

不明白你的编码是怎么弄的，代码仅供参考

我就是我2020

老骥705664849 发表于 2020-7-8 20:57
不明白你的编码是怎么弄的，代码仅供参考

你给的代码，只有分类1而已，【分类1的代码，我知道，】 我主要的是需要分类2的，使用代码  透视出  仓库中的  姓名  编辑  金额   这个不懂
相当于 分类1一个代码模板         分类2  一个代码模板，但所需要的资料不一样

老骥705664849

Sub 分类()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Dim br(), cr()
ar = Sheets("仓库").[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To 3)
ReDim cr(1 To UBound(ar), 1 To 3)
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        t = d(Trim(ar(i, 1)))
        If t = "" Then
            k = k + 1
             d(Trim(ar(i, 1))) = k
             t = k
             br(k, 1) = ar(i, 1)
             br(k, 2) = ar(i, 2)
        End If
        br(t, 3) = br(t, 3) + ar(i, 3)
    End If

    If Trim(ar(i, 4)) <> "" Then
        tk = d(Trim(ar(i, 4)))
        If tk = "" Then
            kk = kk + 1
             d(Trim(ar(i, 4))) = kk
             tk = kk
             cr(kk, 1) = ar(i, 4)
             cr(kk, 2) = ar(i, 2)
        End If
        cr(tk, 3) = cr(tk, 3) + ar(i, 3)
    End If
   
Next i
With Sheets("分类1")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(k, 3) = br
End With
With Sheets("分类2")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(kk, 3) = cr
End With
            
End Sub

老骥705664849

说明你根本不懂代码，或者说你根本没有认真的研究代码，无非是代码中一个阿拉伯数据的错误而已

我就是我2020

老骥705664849 发表于 2020-7-9 11:23
说明你根本不懂代码，或者说你根本没有认真的研究代码，无非是代码中一个阿拉伯数据的错误而已

谢谢  ，我已经自己研究出来了