Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
5.2k views
in Technique[技术] by (71.8m points)

vba - Converting cells into dictionary in Excel

I have a worksheet with data in columns A through D.

I am looking for a convenient way to take these columns and convert to dictionary where the cell in column A is the key and column B, C, D forms an array and subsequently, the value.

For example, if we have:

      A       B        C        D
1   Apple    Red     Round    Yummy
2   Banana  Yellow  Crescent  

The Macro would produce a dictionary with two keys (Apple, Banana), and an array as the value for apple ("Red", "Round", "Yummy"), and an array as the value for Banana ("Yellow", "Crescent", ""). There will be no empty spaces in column A to be skipped, so the macro could stop building the dictionary with the first cell in column A that doesn't have a value. If there is an empty cell in columns B, C or D, the array would hold it's place with "".

I hope to access this dictionary using the key later and extracting the values associated with the key to fill cells on a different worksheet, using a different macro.

Thanks in advance.

Edit:

Thanks for the pointers everyone! I was not sure exactly where to begin as I am new to the VBA language.

So here is where I am at currently. I have a couple issues.

  1. The various variables stored in the info array have values of "" according to the debugger

  2. The last three lines are causing the type mismatch (runtime 13) error.

    'Filling in Facility values from dictionary
    'Set up variables to capture data from contact table
    Dim dict As Dictionary
    Dim r As Integer
    Dim facilityID As String
    Dim facilityName As String
    Dim nameOnForm As String
    Dim contact As String
    Dim phone As String
    Dim fax As String
    Dim copies As Integer
    Dim info As Collection
    
    
    'Create the dictionary
    Set dict = New Dictionary
    Set info = New Collection
    
    'Initialize additional variables to aid iteration through table
    copies = 0
    r = 2 'First row contains header, so start at row 2
    
    facilityID = Worksheets("Contact List").Cells(r, 1).Value
    facilityName = Worksheets("Contact List").Cells(r, 2).Value
    nameOnForm = Worksheets("Contact List").Cells(r, 3).Value
    contact = Worksheets("Contact List").Cells(r, 4).Value
    phone = Worksheets("Contact List").Cells(r, 5).Value
    fax = Worksheets("Contact List").Cells(r, 6).Value
    
    
   

    'keep processing data until we run out of facilityIDs
    While Len(nameOnForm) > 0
        
        'If entry already in dict (unusual), then increment copy count
        If dict.Exists(nameOnForm) Then
            copies = copies + 1
            MsgBox "You have more than one facility with the same name!"
            
        'If not already in dict
        Else
            'First build the array object that will become the value
            info.Add facilityID
            info.Add nameOnForm
            info.Add contact
            info.Add phone
            info.Add fax
            
            'Add the key value pair to the dictionary
            dict.Add facilityName, info
        End If
        
        'increment the row we are looking at
        r = r + 1
        
        'update references accordingly
        facilityID = Worksheets("Contact List").Cells(r, 1).Value
        facilityName = Worksheets("Contact List").Cells(r, 2).Value
        nameOnForm = Worksheets("Contact List").Cells(r, 3).Value
        contact = Worksheets("Contact List").Cells(r, 4).Value
        phone = Worksheets("Contact List").Cells(r, 5).Value
        fax = Worksheets("Contact List").Cells(r, 6).Value
    
    Wend
    
    Worksheets("CRA Form").Range("D12").Value = dict(facilityName)(2) 'Contact
    Worksheets("CRA Form").Range("D14").Value = dict(facilityName)(3) 'Phone
    Worksheets("CRA Form").Range("C16").Value = dict(facilityName)(4) 'Fax

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

I was able to solve the issue with the following code. As I am not familiar with VBA, figuring out the syntax of the dictionary object (along with the fact that I was having to import the scripting library), I decided using a 2D array would be much simpler. It turned out to be much less code (although it could still definitely be condensed), and much simpler to read all around. I want to thank everyone for their help, it was much appreciated!

Cheers.

'create2DArray
Dim myValues2Array() As Variant
    
'declare variables to hold loop counters used to iterate through the individual values i
Dim rowCounter As Long
Dim columnCounter As Long
    
    
'assign values to 2DArray
myValues2Array = ThisWorkbook.Worksheets("Contact List").range("C2:F153").Value
    
For rowCounter = LBound(myValues2Array, 1) To UBound(myValues2Array, 1)
    
    'loop through each value in second array dimension (column)
    For columnCounter = LBound(myValues2Array, 2) To UBound(myValues2Array, 2)
        
        If CStr(myValues2Array(rowCounter, columnCounter)) = CStr(Worksheets("Template").range("B2").Value) Then
                
            Worksheets("CRA Form").range("D12").Value = CStr(myValues2Array(rowCounter, columnCounter + 1)) 'Contact
            Worksheets("CRA Form").range("D14").Value = CStr(myValues2Array(rowCounter, columnCounter + 2)) 'Phone
            Worksheets("CRA Form").range("C16").Value = CStr(myValues2Array(rowCounter, columnCounter + 3)) 'Fax
                
            MsgBox myValues2Array(rowCounter, columnCounter) & "'s info was filled in"
            
        End If
            
    Next columnCounter
        
Next rowCounter

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...