Сохранить диапазон в словарь с 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

Нажмите Ожидаемый результат ..... Нажмите необработанные данные Столбец E - это Год и дата (для использования в качестве ключа): Столбец C эквивалентен наилучшему истолбец объединения ... Столбец сумм G, H, I, J, L с аналогичными "год и дата + аналогичный столбец C" ... Я использую словарь, потому что я могу добавить данные вместе, запустив VBA, так как больше данныхдобавлено @ QHarr

QHarr .. поддельные данные

Answer 2

Вы можете запустить что-то вроде кода ниже.Вы можете использовать словарь словарей.Я решил создать ключ, который представляет собой конкатенацию значения 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

---

Данные:

---

Выход:

Непосредственное окно

Листовой выход