arrays - 从数据表/字典到工作表的字典

Question

你好，

我有一个表格，其中包含每个部门每周的销售额，格式如下:

       Week1 Week2 Week3 ...
Dept1   10    20    10
Dept1   20    10    30
Dept1   30    30    20
Dept2   20    20    30
Dept2   20    20    10
Dept3   50    40    60
 ...

我需要做的是创建一个较小的报表来汇总每个部门的销售额。按照以下模板:

       Week1 Week2 Week3
Dept1   60    60    60
Dept2   40    40    40
Dept3   50    40    60
Total   150   140   160

每个部门的行数各不相同。然后应该将此报告打印在电子表格上。

据我了解，这可以使用字典或集合来完成。到目前为止，我已经设法计算出每周的总和，但是，我不明白如何将这些结果转移到工作表中。我试过将总和转移到数组，但没有成功。

这是我目前的代码。它会正确计算每周的总和，然后清空集合并在下一周再次计算。所以，我的主要问题是如何将这些结果写入工作表。

Dim collection As collection
Dim dataitems As Itemlist 'defined in classmodule
Dim key As String
Dim item As Double
Dim row As Long, column As Long
Dim lstrow As Long, lstcolumn As Long

Set collection = New collection
columnindex = 3 'that is the column where name of departments appear
lstrow = Sheet1.Cells(Sheet1.Rows.Count, column).End(xlUp).row
lstcolumn = Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).column

For column = 5 To lstcolumn 'column 5 is where the weekly data start
    For row = 2 To lstrow 'first 1 contains titles
        key = CStr(Sheet1.Cells(row, "C").Value2)
        item = CDbl(Sheet1.Cells(row, column).Value2)

        Set dataitems = Nothing: On Error Resume Next
        Set dataitems = collection(key): On Error GoTo 0

        If dataitems Is Nothing Then
            Set dataitems = New Itemlist
            dataitems.key = key
            collection.Add dataitems, key
        End If

        With dataitems
            .Sum = .Sum + item
            .Itemlist.Add item
        End With
    Next

Set collection = New collection

Next

感谢任何帮助。谢谢。

Answer 1

您可能有一个有效的代码，但我想向您展示一种不同的方法来实现您的目标。

此方法包含 3 个部分。

1-Control your unique keys(dept names) in a dictionary as keys.

2-Your weekly sums to be stored in an array, as values of your dictionary.

3-Sum your unique dept names using Application.SumIf in a single line.

你的字典的最终结果是这样的(我用你的模板来演示和比较):

dict = {key1:value1,key2:value2,key3:value3)

For example:

dict = {"Dept1":(60,60,60),"Dept2":(40,40,40),"Dept3":(50,40,60)}

如您所见，值是数组，其中包含部门名称的每周总和。

但是，这些数组并不是为每个部门名称声明的。它们实际上是另一个数组内部的数组，就像这样:

arr1 = (arr1_1(),arr1_2(),arr1_3())

For example:

arr1 = ((60,60,60),(40,40,40),(50,40,60))

现在如果要获取dept3的每周总计，基本上就是

arr1(2) which is (50,40,60)

如果要获取dept3第二周的总数，就是

arr1(2)(1) which is 40

我希望你明白了。在我们开始之前还有一件事，你在你的代码中评论了:

'that is the column where name of departments appear

'column 5 is where the weekly data start

'first 1 contains titles

所以我也这样做了，这是代码:

Sub ArrayMyDictionary()
Dim dict As Object, lastrow As Long, lastcol As Long, i As Long, j As Long, c As Long
Dim arr1() As Variant, arr2() As Variant
Set dict = CreateObject("Scripting.Dictionary")

With Worksheets("Sheet1")
    lastrow = .Cells(.Rows.Count, 3).End(xlUp).Row
    lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    ReDim arr1(c) 'array1 initial size 0, later on size is number dept
    ReDim arr2(lastcol - 5) 'array2 size is number of weeks

    For i = 2 To lastrow
        If Not dict.Exists(.Cells(i, 3).Value) Then 'check if Dept not exists in dict
            ReDim Preserve arr1(c)
            arr1(c) = arr2() ' create empty array2 (size is number of weeks) as an element of current array1
            For j = 5 To lastcol
                arr1(c)(j - 5) = Application.SumIf(.Range(.Cells(2, 3), .Cells(lastrow, 3)), .Cells(i, 3).Value, .Range(.Cells(2, j), .Cells(lastrow, j)))
            Next
            dict(.Cells(i, 3).Value) = arr1(c) ' create key (Dept name) and value (an array that holds relevant weekly sums)
            c = c + 1
        End If
    Next
End With

'this part will print out your results to Sheet2
With Worksheets("Sheet2")
    Dim key As Variant
    For Each key In dict.Keys
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = key 'last empty row - print key
        For j = 0 To lastcol - 5
            .Cells(.Rows.Count, 1).End(xlUp).Offset(0, j + 1) = dict(key)(j) 'same row proceed to cell on right - print each element in array inside value
        Next j
    Next key
    .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = "Total" 'last row - calculate totals
    For j = 0 To lastcol - 5
        .Cells(.Rows.Count, 1).End(xlUp).Offset(0, j + 1) = Application.WorksheetFunction.Sum(.Columns(j + 2)) 'same row proceed to cell on right - sum of columns
    Next j
End With
End Sub