vba - 使用 Excel VBA 将范围保存到字典

Question

我有一个包含以下行和列的 excel 表。我想将其保存到字典中，以便我可以使用 A 列中的年份作为引用每一行的键，然后在 A 列中添加具有相同年份的行值。

请问我怎么能做到这一点，因为我被困在这个代码上。谢谢

A  ....|.. B..| ..C..|..D.                                                                            
 2014  | UNION| 5677 | 4556                  
 2014  | UNION| 5677 | 4556                
 2015  | BEST | 5677 | 4556              
 2015  | BEST | 5677 | 4556

这是我的代码。

Sub AnyThing()
Dim lastrow_DE As Integer

lastrow_DE = DEsheet.Cells(DEsheet.Rows.Count, "E").End(xlUp).Row

DEsheet.Range("A1:L" & lastrow_DE).Select

Selection.AutoFilter field:=2, Criteria1:=Array("UNION", "BEST"), Operator:=xlFilterValues

Selection.AutoFilter field:=5, Criteria1:=Array("2014", "2015"), Operator:=xlFilterValues


Dim rng As Range

Set rng = DEsheet.Range("A2:L" & lastrow_DE).SpecialCells(xlCellTypeVisible)


Dim p As Variant

Dim dict As Scripting.Dictionary

Set dict = New Scripting.Dictionary


For Each p In rng

dict.Add key = p.Items(1).Value, items =p.Items(2).Value, p.Items(3).Value, p.Items(4).Value

Next

Else

End If
End Sub

Answer 1

您可以运行类似下面的代码。您可以使用字典词典。我选择创建一个键，它是 yearn 和您的第二个过滤器值的串联，然后在写回工作表时将其拆分出来。

请注意，当您在 A 列中显示年份时，我已将您的第二个条件字段更改为一个。

代码:

Option Explicit

Public Sub AnyThing()
    Dim lastrow_DE As Long
    Dim DEsheet As Worksheet
    Set DEsheet = ActiveSheet

    lastrow_DE = DEsheet.Cells(DEsheet.Rows.Count, "E").End(xlUp).Row

    With DEsheet.Range("A1:L" & lastrow_DE)
        .AutoFilter field:=2, Criteria1:=Array("UNION", "BEST"), Operator:=xlFilterValues
        .AutoFilter field:=1, Criteria1:=Array("2014", "2015"), Operator:=xlFilterValues
    End With

    Dim rng As Range, p As Variant, dict As Scripting.Dictionary
    '<== You should add a test here that filter columns contain filter values i.e. there will be visible cells after applying filter
    Set rng = DEsheet.Range("A2:L" & lastrow_DE).SpecialCells(xlCellTypeVisible)
    Set dict = New Scripting.Dictionary

    For Each p In rng.Columns(1).Cells
        If Not dict.Exists(p.Value & "," & p.Offset(, 1)) Then
            dict.Add p.Value & "," & p.Offset(, 1), Application.WorksheetFunction.Sum(p.Offset(, 2).Resize(1, 10))
        Else
            dict(p.Value & "," & p.Offset(, 1)) = dict(p.Value & "," & p.Offset(, 1)) + Application.WorksheetFunction.Sum(p.Offset(, 2).Resize(1, 10))
        End If
    Next p

    Dim key As Variant

    For Each key In dict.Keys
        Debug.Print key & " : " & dict(key)
    Next key

    Sheets.Add

    Dim counter As Long

    With ActiveSheet
        For Each key In dict.Keys
            counter = counter + 1
            .Cells(counter, "A").Resize(1, 2) = Split(key, ",")
            .Cells(counter, "C") = dict(key)

        Next key
    End With

End Sub

数据:



输出:

即时窗口



工作表输出