несоответствие типов в динамическом массиве в словаре - PullRequest
Новая
       10

несоответствие типов в динамическом массиве в словаре

0 голосов
/ 03 июля 2018

Я пытаюсь создать словарь со строкой в ​​качестве ключа и массивом строк в качестве элемента, но я не могу создать динамический массив, который можно расширять новыми значениями, когда ключ уже находится в словаре. Я получил несоответствие типа с: RecordArray(UBound(RecordArray)) = Split(records, ",") и не знаю, как исправить эту строку. Теперь я даже уверен, что остальная часть этого цикла верна, но сейчас я получаю сообщение об ошибке в этой части. 

Excel file looks like this:
A1: 2015  B1:  00002,00003,00004
A2: 2022  B2:  00011,00012
A3: 2029  B3:  00123,00124
A4: 2037  B4:  00095,00096,00097,00098
A5: 8000  B5:  01010,01011,01012
A6: 8002  B6:  02001,02002,02003,02004
A7: 2029  B7:  01111,01112,01113,01114,01115,01116
A8: 8000  B8:  00007,00008,00009,00010
A9: 2015  B9:  00601,00602,00603
A10:2015  B10: 00708,00709,00710,00711
A11:2015  B11: 00888,00889,00890,00891



Sub hyc()

    Dim i As Integer

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

        Dim records As String
        Dim RecordArray() As String

        Dim x As Integer
          Application.ScreenUpdating = False
          ' Set numrows = number of rows of data.
          NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
          ' Select cell a1.
          Range("A1").Select
          ' Establish "For" loop to loop "numrows" number of times.

          For x = 1 To NumRows

             If IsNumeric(Cells(x, 1).Value) Then
                If dict.Exists(Cells(x, 1).Value) Then
                    records = Trim(Cells(x, 2).Value)
                    ReDim Preserve RecordArray(UBound(RecordArray) + 1)
                    RecordArray(UBound(RecordArray)) = Split(records, ",")
                    dict(Cells(x, 1).Value) = RecordArray()

                    x = x + 1

                Else
                    records = Trim(Cells(x, 2).Value)
                    RecordArray() = Split(records, ",")
                    dict.Add key:=(Cells(x, 1).Value), Item:=RecordArray()


                End If

             ActiveCell.Offset(1, 0).Select

          End If
          Next x


          Application.ScreenUpdating = True

    Dim key As Variant
            For Each key In dict.Keys
                    MsgBox key
                    i = 0
                    For Each Item In dict(key)
                        MsgBox (dict(key)(i))
                        i = i + 1
                    Next Item
            Next key

    End Sub

Буду благодарен за любую помощь:).

1 Ответ

0 голосов
/ 03 июля 2018

вы можете отложить разделение до финального цикла высказывания 

Option Explicit

Sub hyc()
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary

    Dim x As Long
    For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row ' loop through 1 and column A last not empty cell row index
        If IsNumeric(Cells(x, 1).Value) Then dict(Cells(x, 1).Value) = dict(Cells(x, 1).Value) & " " & Replace(Trim(Cells(x, 2).Value), ",", " ") 'update dictionary item whose key is current column A cell content
    Next

    Dim key As Variant, item As Variant
    For Each key In dict.Keys ' loop throug dictionary keys
        MsgBox key
        For Each item In Split(Trim(dict(key)), " ") 'loop through current dictionary key item items
            MsgBox item
        Next
    Next
End Sub
...