Question

嗨，我正试图取消我的excel工作表（将水平方向转换为垂直方向），但我不断得到：

运行时错误'13'类型不匹配

我的CreateDictionaryFromRowArrays函数中的

。调试器显示错误在这里：

For Idx = 1 To UBound(Keys)：

Public Sub TransposeHorizontalToVertical()

Dim lngLastRow As Long, lngIdx As Variant, lngOutputLastRow As Variant, _
    lngDetailsIdx As Variant, lngTargetRow As Variant, lngTargetCol As Variant
Dim wksInput As Worksheet, wksOutput As Worksheet
Dim varDetailNames As Variant, varBrokersNames As Variant, _
    varDetails As Variant, varValues As Variant
Dim varDetailsKey As Variant, varValuesKey As Variant
Dim dicDetails As Scripting.Dictionary, dicValues As Scripting.Dictionary
Dim lCol As Long

'Set references up-front
Set wksInput = ThisWorkbook.Sheets("analysts_entl_export_Q2 Entitle")
Set wksOutput = ThisWorkbook.Sheets.Add
With wksOutput
    .Cells(1, 1) = "name"
    .Cells(1, 2) = "email"
    .Cells(1, 3) = "mapped"
    .Cells(1, 4) = "product"
    .Cells(1, 5) = "clientName"
End With
lngTargetRow = 2

'Identify the critical details and values on our Input worksheet
With wksInput
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
    varDetailNames = .Range("A1:C1")
    varClientsNames = .Range("D1")
End With

'Loop through the rows, creating dicts then outputting results
For lngIdx = 2 To lngLastRow

    With wksInput

        lCol = Cells(1, Columns.Count).End(xlToLeft).Column

        'Initialize the dictionary variables
        Set dicDetails = New Scripting.Dictionary
        Set dicValues = New Scripting.Dictionary

        'Grab the details and the months for this row
        varDetails = .Range(.Cells(lngIdx, 1), .Cells(lngIdx, 3))
        varValues = .Range(.Cells(lngIdx, 4), .Cells(lngIdx, lCol))

    End With

    'Create the detail dictionary and the value dictionary using
    'the custom function written below
    Set dicDetails = CreateDictionaryFromRowArrays(varDetailNames, varDetails)
    Set dicValues = CreateDictionaryFromRowArrays(varBrokersNames, varValues)

    With wksOutput

        'Loop through the Values dictionary to create output rows
        For Each varValuesKey In dicValues.Keys

            'Initialize the target column
            lngTargetCol = 1

            'Write the details to the output sheet
            For Each varDetailsKey In dicDetails.Keys
                .Cells(lngTargetRow, lngTargetCol) = dicDetails(varDetailsKey)
                lngTargetCol = lngTargetCol + 1
            Next varDetailsKey

            'Write the values (month) to the output sheet
            .Cells(lngTargetRow, lngTargetCol) = varValuesKey
            lngTargetCol = lngTargetCol + 1

            'Write the values (volume) to the output sheet
            .Cells(lngTargetRow, lngTargetCol) = dicValues(varValuesKey)

            'Increment the row counter
            lngTargetRow = lngTargetRow + 1

        Next varValuesKey

    End With

Next lngIdx


'Let the user know our script is complete!
MsgBox "Data de-pivot complete!"
End Sub

 Public Function CreateDictionaryFromRowArrays(Keys As Variant, _
                                          Items As Variant) _
                                          As Scripting.Dictionary
Dim Idx As Variant
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary

Dim Results As Variant

For Idx = 1 To UBound(Keys)
    dic.Add Key:=Keys(1, Idx), Item:=Items(1, Idx)
Next Idx
Set CreateDictionaryFromRowArrays = dic
End Function

Answer 1

解决此问题的方法很多。但是，在您的情况下，它会引发错误，因为Keys为空，而您正尝试使用Keys(1, Idx)访问它。您需要某种防御性编程，在调用函数之前检查参数是否为空。

作为快速解决方案，向您显示错误的确切位置，请使用此代码代替函数：

Public Function CreateDictionaryFromRowArrays(Keys As Variant, _
                                                   Items As Variant) As Scripting.Dictionary
    Dim Idx As Variant
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary

    If IsEmpty(Keys) Then MsgBox "KEYS ARE EMPTY?"
    If IsEmpty(Items) Then MsgBox "ITEMS ARE EMPTY?"

    Dim Results As Variant

    For Idx = 1 To UBound(Keys)
        dic.Add Key:=Keys(1, Idx), Item:=Items(1, Idx)
    Next Idx
    Set CreateDictionaryFromRowArrays = dic

End Function

解决这个问题的可能不是那么“丑陋”：

If Not IsEmpty(varDetails) And Not IsEmpty(varDetailNames) Then
    Set dicDetails = CreateDictionaryFromRowArrays(varDetailNames, varDetails)
End If
If Not IsEmpty(varBrokersNames) And Not IsEmpty(varValues) Then
    Set dicValues = CreateDictionaryFromRowArrays(varBrokersNames, varValues)
End If

从数组创建字典时出现运行时错误“ 13”类型不匹配

1 个答案: