Vba字典结果不要正确返回

时间:2017-08-05 06:54:26

标签: excel vba excel-vba dictionary excel-udf

我试图使用字典在column F中查找column C中使用 但结果不会像我想要的那样回归。它显示“0”

方案:
1. column C中的将具有多个相同的值 2.我想根据总结column F中的所有并返回"RAW" Range("C2")

"Sheet2"

This database

"RAW"

This is where I want to lookup

请帮帮我 提前谢谢。
这是我的代码。

Option Explicit

Private Lrow As Long
Private oDict As Object

Private Sub CreateDict()
    Dim arrValues As Variant, oKey As Variant, oValue As Variant, i As Long

'Find Master Item List Japan
    Dim Master As Workbook
    Dim t As Workbook

    For Each t In Workbooks
    If Left(t.Name, 16) = "Master Item List" Then
        Set Master = Workbooks(t.Name)
    End If
Next t

    Set oDict = Nothing
    If oDict Is Nothing Then

        Set oDict = New Scripting.Dictionary

    End If
    ' Add items to the dictionary
    ' Load values of used range to memory
    arrValues = Master.Sheets("Sheet2").UsedRange.Value
    ' Assuming the Key is on first column and Value is on next
    For i = 2 To UBound(arrValues)
        oKey = arrValues(i, 3)
        oValue = arrValues(i, 6)
        If Len(oKey) > 0 Then
            If oDict.Exists(oKey) Then
                ' Append Value to existing key
                oDict(oKey) = oDict(oKey) + oValue
            Else
                ' Add Key and value
                oDict(oKey) = oValue
            End If
        End If
    Next i
End Sub

Function GetList(ByVal oRange As Range) As Variant
    If oDict Is Nothing Then CreateDict
'    Static oDict As Scripting.Dictionary 'precerved between calls
   If oDict.Exists(oRange.Value) Then
        GetList = oDict.Item(oRange.Value)
'   Else
'         GetList = 0
   End If
End Function

仅供参考。
这是我在其他工作簿中使用的代码并且工作得很好

Option Explicit

Private lRow As Long
Private oDict As Object

Private Sub CreateDict()
    Dim arrValues As Variant, oKey As Variant, oValue As Variant, i As Long

'Find Master Item List Japan
    Dim Master As Workbook
    Dim t As Workbook

    For Each t In Workbooks
    If Left(t.Name, 16) = "Master Item List" Then
        Set Master = Workbooks(t.Name)
    End If
Next t

    Set oDict = Nothing
    If oDict Is Nothing Then

        Set oDict = New Scripting.Dictionary

    End If
    ' Add items to the dictionary
    ' Load values of used range to memory
    arrValues = Master.Sheets("Sheet2").UsedRange.Value
    ' Assuming the Key is on first column and Value is on next
    For i = 1 To UBound(arrValues)
        oKey = arrValues(i, 3)
        oValue = arrValues(i, 6)
        If Len(oKey) > 0 Then
            If oDict.Exists(oKey) Then
                ' Append Value to existing key
                oDict.Item(oKey) = oDict.Item(oKey)
            Else
                ' Add Key and value
                oDict.Add oKey, oValue
            End If
        End If
    Next
End Sub

Function GetList(ByVal oRange As Range) As Long
    If oDict Is Nothing Then CreateDict
'    Static oDict As Scripting.Dictionary 'precerved between calls
    If oDict.Exists(oRange.Value) Then
        GetList = oDict.Item(oRange.Value)
    Else
        GetList = 0
    End If
End Function

编辑#1:
基于@YowE3k评论,我尝试执行GetFile函数并得到如下图所示的结果 不太确定为什么最后一个返回0

这可能是因为它在我的字典历史中已经有相同的密钥,因为在其他工作簿中我使用相同的密钥。

Result with code

0 个答案:

没有答案