Excel VBA - Словарь - сохранение и получение значений

Question

Я работаю над таблицей и с помощью Excel VBA - Словарь - я пытаюсь захватить все детали - 1) Первый шаг - поиск в столбце «Результаты» - если значение «Нет» - тогда нам нужно прочитать все значения с соответствующим заголовком. 2) Итак, для 2-й записи - т. Е. Name = XYZ - нам нужно сохранить все детали. Основываясь на столбце «Кол-во предметов» - нам нужно сохранить ценность всех предметов и их соответствующих меток - будут использоваться для дальнейшего расчета и создания столбца «Результат».

Я получил это частично работает - как я могу захватить детали - но не в состоянии хранить информацию о всех субъекта и их знаки:

Sr. No. Results Out? Result Name Age No. of Subjects Subject Names Marks 
1   Yes   Pass ABC  21  3   Maths   10 
                  Science   26 
                  History   34 
2   No     XYZ  10  2   Maths   24 
                  Science   36 

Ниже приведен код, который я использовал, что частично работая:

Public Sub test_dict() 

Dim dict As New Scripting.dictionary 
Set dict = New dictionary 

sSheetIndex = 1 
intTargetRow = 2 

Set objUsedRange = Worksheets.Item(3).UsedRange 

For Iter = 1 To objUsedRange.Columns.Count 
    sCellName = objUsedRange.Cells(1, Iter) 
    sCellValue = objUsedRange.Cells(intTargetRow, Iter) 
    dict.Item(sCellName) = sCellValue 

Next 


For i = 0 To dict.Count - 1 
    s = dict.Items()(i) 
    Debug.Print dict.Keys()(i) & " " & dict.Items()(i) 
    Debug.Print s 
Next i 

End Sub 

Answer 1

Решена проблема с кодом ниже - пришлось использовать 2 отдельные словари:

Public Sub test_dict() 

Dim dict As New Scripting.dictionary 
Set dict = New dictionary 

sSheetIndex = 1 
intTargetRow = 2 

Set objUsedRange = Worksheets.Item(3).UsedRange 

For Iter = 1 To objUsedRange.Columns.Count 
    sCellName = objUsedRange.Cells(1, Iter) 
    sCellValue = objUsedRange.Cells(intTargetRow, Iter) 
    dict.Item(sCellName) = sCellValue 

    If sCellName = "Subject Names" Then 
     Call test_dict_2 
    End If 

Next 

For i = 0 To dict.Count - 1 
    s = dict.Items()(i) 
    Debug.Print dict.Keys()(i) & " " & dict.Items()(i) 
    Debug.Print s 
Next i 

End Sub 



Public Sub test_dict_2() 

Dim dict_2 As New Scripting.dictionary 
Set dict_2 = New dictionary 

sSheetIndex = 1 
intTargetRow = row_counter 

Set objUsedRange = Worksheets.Item(3).UsedRange 

For Iter = 1 To objUsedRange.Columns.Count 
    sHeader = objUsedRange.Cells(1, Iter) 
    sCellValue = objUsedRange.Cells(intTargetRow, Iter) 

    If sHeader = "No. of Subjects" Then 
     mv_cnt = sCellValue 
    End If 

    If sHeader = "Subject Names" Then 

     Dim a 
     a = Iter + mv_cnt 
     For Iter_2 = Iter To (a - 1) 

      sHeader = objUsedRange.Cells(1, Iter) 
      sCellName = objUsedRange.Cells(intTargetRow, Iter) 
      sCellValue = objUsedRange.Cells(intTargetRow, Iter + 1) 
      dict_2.Item(sCellName) = sCellValue 
      intTargetRow = intTargetRow + 1 

     Next 

     intTargetRow = row_counter 

    End If 

Next 

For i = 0 To dict_2.Count - 1 
    s = dict_2.Items()(i) 
    Debug.Print dict_2.Keys()(i) & " " & dict_2.Items()(i) 
    Debug.Print s 
Next i 

Set dict_2 = Nothing 

End Sub