代码之家 › 专栏 › 技术社区 › David

词典exists(key)添加密钥

dictionary vba

David · 技术社区 · 3 年前

我对vba字典非常着迷,因为Exists()方法毫无意义。

我想您可以使用dict.Exists(key)方法来检查字典中是否有密钥,而无需进一步操作。问题是,在检查时,密钥会自动添加到字典中。这真的毫无意义!

这是我的密码。我做错什么了吗?

Function getContracts(wb As Workbook) As Dictionary
   Dim cData As Variant, fromTo(1 To 2) As Variant
   Dim contracts As New Dictionary, ctrDates As New Collection
   Dim positions As New Dictionary, p As Long, r As Long
   Dim dataSh As String, i As Long
   
   dataSh = "Export"
   
   cData = wb.Worksheets(dataSh).UsedRange
   
   For i = LBound(cData) To UBound(cData)
      fromTo(1) = cData(i, 1)
      fromTo(2) = cData(i, 2)
      Set ctrDates = Nothing
      If IsDate(fromTo(1)) And IsDate(fromTo(2)) Then
         If Not contracts.Exists(cData(i, 3)) Then ' Here it detects correctly that the key doesn't exist
            ctrDates.Add fromTo 
            contracts.Add cData(i, 3), ctrDates ' And here it fails because the key just got added by .Exists()
         Else
            Set ctrDates = contracts(cData(i, 3))
            ctrDates.Add fromTo
            contracts(cData(i, 3)) = ctrDates
         End If
      Else
         Debug.Print "Not a valid date in line " & i
      End If
      
   Next i
   
End Function

0 回复 | 直到 3 年前

Storax 3 年前

您可以将代码缩短为

   For i = LBound(cData) To UBound(cData)
      fromTo(1) = cData(i, 1)
      fromTo(2) = cData(i, 2)
      Set ctrDates = Nothing
      If IsDate(fromTo(1)) And IsDate(fromTo(2)) Then
            If Not IsEmpty(contracts(cData(i, 3))) Then Set ctrDates = contracts(cData(i, 3))
            ctrDates.Add fromTo
            Set contracts(cData(i, 3)) = ctrDates

      Else
         Debug.Print "Not a valid date in line " & i
      End If
      
   Next i

如果更改某个键的值,如果该键不存在,它将自动添加该键。

进一步阅读 dictionaries

附言 :这也可能会避免评论中描述的奇怪行为,因为您不使用 exist 方法但另一方面,我在使用字典时从未经历过如此奇怪的行为

VBasic2008 3 年前

字典中日期对的集合

提及 Microsoft Scripting Runtime 图书馆是这项工作的必要条件。

Option Explicit

Sub GetContractsTEST()

    Const dName As String = "Export"

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)

    Dim Contracts As Scripting.Dictionary: Set Contracts = GetContracts(dws)
    If Contracts Is Nothing Then Exit Sub

    Dim Key As Variant, Item As Variant
    For Each Key In Contracts.Keys
        Debug.Print Key
        For Each Item In Contracts(Key)
            Debug.Print Item(1), Item(2)
        Next Item
    Next Key

End Sub

Function GetContracts(ByVal ws As Worksheet) As Scripting.Dictionary
    Const ProcName As String = "GetContracts"
    On Error GoTo ClearError

    Dim cData As Variant: cData = ws.UsedRange.Value
    Dim fromTo(1 To 2) As Variant

    Dim Contracts As New Scripting.Dictionary
    Contracts.CompareMode = TextCompare
    
    Dim r As Long

    For r = LBound(cData) To UBound(cData)
        fromTo(1) = cData(r, 1)
        fromTo(2) = cData(r, 2)
        If IsDate(fromTo(1)) And IsDate(fromTo(2)) Then
            If Not Contracts.Exists(cData(r, 3)) Then
                Set Contracts(cData(r, 3)) = New Collection
            End If
            Contracts(cData(r, 3)).Add fromTo
        Else
            Debug.Print "Not a valid date in line " & r
        End If
    Next r

    Set GetContracts = Contracts

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function