时间戳

首页 > 解决方案 > 字典中动态数组的类型不匹配

vba - 字典中动态数组的类型不匹配

问题描述

我正在尝试使用字符串作为键和字符串数组作为项来创建字典，但是当键已经在字典中时，我正在努力制作可以用新值扩展的动态数组。我的类型不匹配： 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

我将不胜感激任何帮助:)。

标签： vbadictionarydynamic-arraystype-mismatch

解决方案

您可以将拆分推迟到最后的发言循环

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

推荐阅读