Question

我的任务是总结一些数据。目前，我在VBA中创建了一个支点，并将其复制到一个加载到另一个系统的工作表中。我们的一些用户文件的长度不断增长（450k +行excel 2013 32bit）以及代码在数据透视过程中出错的复杂程度。我想使用脚本字典来产生相同的输出，但在找到一个例子并在最近几天玩它之后我需要一些帮助。在代码的标题中，我放置了一个数据样本和我得到的输出与我需要的输出，这基本上是一个表格枢轴。真实的例子有点复杂，但我想，一旦我看到它，我就可以解决它。我只是遗漏了一些关于如何流向工作表并且很难找到资源来教育自己组合下面的方法的东西。感谢

Sub test()

'DATA:
'2005-00000  may 100
'2005-00000  may 100
'2005-00000  may 100
'2005-00000  jun 100
'2005-00000  jun 100
'2005-99999  feb 100
'2005-99999  feb 100
'2005-99999  Nov 100
'2005-22222  apr 100
'2005-22222  apr 100

'Output with Code Below
'            may june   feb Nov apr
'2005-00000  300 200
'2005-99999              200 100
'2005-22222                     200


'Desired Output
'2005-00000  may 300
'2005-00000  jun 200
'2005-99999  feb 200
'2005-99999  Nov 100
'2005-22222  apr 200

Dim strtest As String
Dim a, b(), i As Long, n As Long, t As Long
Dim dict1 As Object, dic2 As Object
Set dict1 = CreateObject("Scripting.Dictionary")
dict1.CompareMode = vbTextCompare
Set dict2 = CreateObject("Scripting.Dictionary")
dict2.CompareMode = vbTextCompare
With Range("a1").CurrentRegion.Resize(, 3)

    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1))
    b(1, 1) = Name: n = 1: t = 1
    For i = 1 To UBound(a, 1)
        If Not dict1.Exists(a(i, 1)) Then
            n = n + 1: b(n, 1) = a(i, 1)
            dict1.Add a(i, 1), n
        End If
        If Not dict2.Exists(a(i, 2)) Then
            t = t + 1: b(1, t) = a(i, 2)
            dict2.Add a(i, 2), t
        End If
        b(dict1(a(i, 1)), dict2(a(i, 2))) = b(dict1(a(i, 1)), dict2(a(i, 2))) + a(i, 3)


    Next
    With .Resize(1, 1).Offset(, .Columns.Count + 1)
        .CurrentRegion.ClearContents
        .Resize(n, t).Value = b
    End With
End With
Set dict1 = Nothing: Set dict2 = Nothing
End Sub

Answer 1

另一种（字典）解决方案

Option Explicit

Sub test2()

With ActiveSheet.Range("A1").CurrentRegion.Offset(, 3).Resize(, 1)
    .FormulaR1C1 = "=concatenate(RC[-3], ""§§"", RC[-2])"
    .Value = .Value
    .Copy .Offset(, 1)
    .Offset(, 1).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    .Offset(, 1).TextToColumns Destination:=.Offset(, 2), DataType:=xlDelimited, Other:=True, OtherChar:="§§"
    .Offset(, 4).Resize(.Offset(, 1).SpecialCells(xlCellTypeConstants).Rows.Count).FormulaR1C1 = "=SUMIFS(C3,C1,RC[-2],C2,RC[-1])"
    .Resize(, 2).ClearContents
End With

End Sub

如果有很多行并且花费时间，您可能需要在Application.ScreenUpdating = False之前添加With...语句，并在{{1}之后添加Application.ScreenUpdating = True语句一个

使用VBA重现表格透视

1 个答案: