Fatal编程技术网
  • excel/
  • Excel 更新字典中的项时出现意外行为

Excel 更新字典中的项时出现意外行为

excel vba

Excel 更新字典中的项时出现意外行为,excel,vba,Excel,Vba,打开工作簿时，我正在字典中存储单元格的值。字典键是从A3开始到A60的单元格地址，因为这些是唯一的值，字典项是基于列a中行偏移量的值使用类模块生成的。我在运行我的updateLocationary过程时注意到，添加了字典的新键，而不是更新字典中的现有键（在这种情况下，添加的键是T5），当它应该根据A5键更新单元格T5的值时，我不知道为什么，因为我对VBA中的模块和字典类非常陌生 课程模块 Option Explicit '--- Class: LoanData Public LoanAmoun

打开工作簿时，我正在字典中存储单元格的值。字典键是从A3开始到A60的单元格地址，因为这些是唯一的值，字典项是基于列a中行偏移量的值使用类模块生成的。

我在运行我的
updateLocationary
过程时注意到，添加了字典的新键，而不是更新字典中的现有键（在这种情况下，添加的键是T5），当它应该根据A5键更新单元格T5的值时，我不知道为什么，因为我对VBA中的模块和字典类非常陌生

课程模块

Option Explicit

'--- Class: LoanData
Public LoanAmount As String
Public TitleCompany As String
Public Notes As String
Public CloseDate As String
Public PurchasePrice As String
Public Product As String
Public LoanNumber As String
Public CustomerName As String
Public Processor As String
Public Sub Populate(ByRef loanDetails As Range)
    With loanDetails
        LoanAmount = Trim(.Offset(0, 16).Value)
        CloseDate = Trim(.Offset(0, 10).Value)
        Notes = Trim(.Offset(0, 19).Value)
        LoanNumber = Trim(.Offset(0, 0).Address(False, False))
        Product = Trim(.Offset(0, 17).Value)
        PurchasePrice = Trim(.Offset(0, 15).Value)
        TitleCompany = Trim(.Offset(0, 4).Value)
        CustomerName = Trim(.Offset(0, 1).Value)
        Processor = Trim(.Offset(0, 2).Value)
    End With
End Sub
工作簿打开事件

Option Explicit
Private Sub Workbook_Open()
    If Not isReadOnly(PIPELINEFILE) Then
        Dim uname As String
        uname = LCase(Environ("username"))
        Select Case uname
            Case Is = "zacke"
                CreateLoanDictionary
            Case Else
                Exit Sub
        End Select
    End If
End Sub
Public Function isReadOnly(ByVal fName As String) As Boolean
    If Len(fName) > 0 Then
        isReadOnly = GetAttr(fName) And vbReadOnly
    End If
End Function

Option Explicit
Private AllLoans As Dictionary
Public Sub CreateLoanDictionary(Optional ByVal forceNewDictionary As Boolean = False)
    '--- if the dictionary already exists, we don't have to recreate it
    '    unless it's forced
    If forceNewDictionary Or (AllLoans Is Nothing) Then
        Set AllLoans = New Dictionary
        Dim loanNumbers As Range
        Set loanNumbers = Sheet1.Range("LoanNums")
        Dim lNum As Range
        For Each lNum In loanNumbers
            UpdateLoanDictionary lNum
        Next lNum
    End If
End Sub
Public Sub UpdateLoanDictionary(ByRef thisLoanNumber As Range)
    '--- just in case this Sub is called before the dictionary is created
    If AllLoans Is Nothing Then CreateLoanDictionary
    'If IsEmpty(thisLoanNumber.Value) Then Exit Sub

    Dim thisLoan As New LoanData
    thisLoan.Populate thisLoanNumber

    If Not AllLoans.Exists(thisLoan.LoanNumber) Then
        AllLoans.Add thisLoan.LoanNumber, thisLoan
    Else
        AllLoans(thisLoan.LoanNumber) = thisLoan
        Debug.Print thisLoan.LoanNumber
    End If

End Sub
Sub ShowLoans()
    If AllLoans Is Nothing Then
        Debug.Print "This is no loan dictionary!"
    Else
        If AllLoans.Count = 0 Then
            Debug.Print "There is a loan dictionary, but it's empty!"
        Else
            Debug.Print "There are " & AllLoans.Count & " loans in the dictionary:"
            Dim loan As Variant
            For Each loan In AllLoans.Items
            Debug.Print "Loan Number: " & loan.LoanNumber & " Notes: " & loan.Notes
            Next loan
        End If
    End If

End Sub

Option Explicit
Private Sub Worksheet_Activate()
    CreateLoanDictionary
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    Dim lnNotes As Range
    Set lnNotes = Sheet1.Range("LoanNotes")

    Dim NotesChangedCells As Range
    Set NotesChangedCells = Intersect(Target, lnNotes)
    If Not NotesChangedCells Is Nothing Then
        Dim changedCell As Range
        For Each changedCell In NotesChangedCells
            UpdateLoanDictionary lnNum
        Next changedCell
    End If


    Dim rgCells As Range
    Set rgCells = Me.Range("pNames")

    Dim rgSel As Range
    Set rgSel = Intersect(Target, rgCells)

    Dim cell As Range

    If Not rgSel Is Nothing Then
        For Each cell In rgSel
            Select Case LCase(cell.Value)
                Case Is = "zack", "terri", "hunter"
                    Dim oLoan As New LoanData
                    With oLoan
                        .LoanAmount = Format(Trim(cell.Offset(0, 14).Value), "Currency")
                        .CloseDate = Trim(cell.Offset(0, 8).Value)
                        .Notes = Trim(cell.Offset(0, 17).Value)
                        .LoanNumber = Trim(cell.Offset(0, -2).Value)
                        .Product = Trim(cell.Offset(0, 15).Value)
                        .PurchasePrice = Format(Trim(cell.Offset(0, 13).Value), "Currency")
                        .TitleCompany = Trim(cell.Offset(0, 2).Value)
                        .CustomerName = Trim(Split(cell.Offset(0, -1).Value, " - ")(0))
                        .Processor = Trim(cell.Offset(0, 0).Value)
                        If .LoanAmount = "" Or .Product = "" Or .CloseDate = "" Or .Notes = vbNullString Then
                            MsgBox "Sorry, but you need to provide a minimum of:" & vbCrLf & _
                                   "Loan Amount" & vbCrLf & _
                                   "Product" & vbCrLf & _
                                   "Closing Date:" & vbCrLf & _
                                   "Interest Rate:" & vbCrLf & _
                                   "In order to assign a loan processor.", vbOKOnly + vbCritical
                        Else
                            CreateEmail oLoan.Processor, oLoan.CustomerName, oLoan.TitleCompany, oLoan.CloseDate, _
                                        oLoan.PurchasePrice, oLoan.LoanAmount, oLoan.Product, oLoan.Notes
                        End If
                    End With
            End Select
        Next cell
    End If

End Sub
名为NewDict的标准模块

Option Explicit
Private Sub Workbook_Open()
    If Not isReadOnly(PIPELINEFILE) Then
        Dim uname As String
        uname = LCase(Environ("username"))
        Select Case uname
            Case Is = "zacke"
                CreateLoanDictionary
            Case Else
                Exit Sub
        End Select
    End If
End Sub
Public Function isReadOnly(ByVal fName As String) As Boolean
    If Len(fName) > 0 Then
        isReadOnly = GetAttr(fName) And vbReadOnly
    End If
End Function

Option Explicit
Private AllLoans As Dictionary
Public Sub CreateLoanDictionary(Optional ByVal forceNewDictionary As Boolean = False)
    '--- if the dictionary already exists, we don't have to recreate it
    '    unless it's forced
    If forceNewDictionary Or (AllLoans Is Nothing) Then
        Set AllLoans = New Dictionary
        Dim loanNumbers As Range
        Set loanNumbers = Sheet1.Range("LoanNums")
        Dim lNum As Range
        For Each lNum In loanNumbers
            UpdateLoanDictionary lNum
        Next lNum
    End If
End Sub
Public Sub UpdateLoanDictionary(ByRef thisLoanNumber As Range)
    '--- just in case this Sub is called before the dictionary is created
    If AllLoans Is Nothing Then CreateLoanDictionary
    'If IsEmpty(thisLoanNumber.Value) Then Exit Sub

    Dim thisLoan As New LoanData
    thisLoan.Populate thisLoanNumber

    If Not AllLoans.Exists(thisLoan.LoanNumber) Then
        AllLoans.Add thisLoan.LoanNumber, thisLoan
    Else
        AllLoans(thisLoan.LoanNumber) = thisLoan
        Debug.Print thisLoan.LoanNumber
    End If

End Sub
Sub ShowLoans()
    If AllLoans Is Nothing Then
        Debug.Print "This is no loan dictionary!"
    Else
        If AllLoans.Count = 0 Then
            Debug.Print "There is a loan dictionary, but it's empty!"
        Else
            Debug.Print "There are " & AllLoans.Count & " loans in the dictionary:"
            Dim loan As Variant
            For Each loan In AllLoans.Items
            Debug.Print "Loan Number: " & loan.LoanNumber & " Notes: " & loan.Notes
            Next loan
        End If
    End If

End Sub

Option Explicit
Private Sub Worksheet_Activate()
    CreateLoanDictionary
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    Dim lnNotes As Range
    Set lnNotes = Sheet1.Range("LoanNotes")

    Dim NotesChangedCells As Range
    Set NotesChangedCells = Intersect(Target, lnNotes)
    If Not NotesChangedCells Is Nothing Then
        Dim changedCell As Range
        For Each changedCell In NotesChangedCells
            UpdateLoanDictionary lnNum
        Next changedCell
    End If


    Dim rgCells As Range
    Set rgCells = Me.Range("pNames")

    Dim rgSel As Range
    Set rgSel = Intersect(Target, rgCells)

    Dim cell As Range

    If Not rgSel Is Nothing Then
        For Each cell In rgSel
            Select Case LCase(cell.Value)
                Case Is = "zack", "terri", "hunter"
                    Dim oLoan As New LoanData
                    With oLoan
                        .LoanAmount = Format(Trim(cell.Offset(0, 14).Value), "Currency")
                        .CloseDate = Trim(cell.Offset(0, 8).Value)
                        .Notes = Trim(cell.Offset(0, 17).Value)
                        .LoanNumber = Trim(cell.Offset(0, -2).Value)
                        .Product = Trim(cell.Offset(0, 15).Value)
                        .PurchasePrice = Format(Trim(cell.Offset(0, 13).Value), "Currency")
                        .TitleCompany = Trim(cell.Offset(0, 2).Value)
                        .CustomerName = Trim(Split(cell.Offset(0, -1).Value, " - ")(0))
                        .Processor = Trim(cell.Offset(0, 0).Value)
                        If .LoanAmount = "" Or .Product = "" Or .CloseDate = "" Or .Notes = vbNullString Then
                            MsgBox "Sorry, but you need to provide a minimum of:" & vbCrLf & _
                                   "Loan Amount" & vbCrLf & _
                                   "Product" & vbCrLf & _
                                   "Closing Date:" & vbCrLf & _
                                   "Interest Rate:" & vbCrLf & _
                                   "In order to assign a loan processor.", vbOKOnly + vbCritical
                        Else
                            CreateEmail oLoan.Processor, oLoan.CustomerName, oLoan.TitleCompany, oLoan.CloseDate, _
                                        oLoan.PurchasePrice, oLoan.LoanAmount, oLoan.Product, oLoan.Notes
                        End If
                    End With
            End Select
        Next cell
    End If

End Sub
工作表事件

Option Explicit
Private Sub Workbook_Open()
    If Not isReadOnly(PIPELINEFILE) Then
        Dim uname As String
        uname = LCase(Environ("username"))
        Select Case uname
            Case Is = "zacke"
                CreateLoanDictionary
            Case Else
                Exit Sub
        End Select
    End If
End Sub
Public Function isReadOnly(ByVal fName As String) As Boolean
    If Len(fName) > 0 Then
        isReadOnly = GetAttr(fName) And vbReadOnly
    End If
End Function

Option Explicit
Private AllLoans As Dictionary
Public Sub CreateLoanDictionary(Optional ByVal forceNewDictionary As Boolean = False)
    '--- if the dictionary already exists, we don't have to recreate it
    '    unless it's forced
    If forceNewDictionary Or (AllLoans Is Nothing) Then
        Set AllLoans = New Dictionary
        Dim loanNumbers As Range
        Set loanNumbers = Sheet1.Range("LoanNums")
        Dim lNum As Range
        For Each lNum In loanNumbers
            UpdateLoanDictionary lNum
        Next lNum
    End If
End Sub
Public Sub UpdateLoanDictionary(ByRef thisLoanNumber As Range)
    '--- just in case this Sub is called before the dictionary is created
    If AllLoans Is Nothing Then CreateLoanDictionary
    'If IsEmpty(thisLoanNumber.Value) Then Exit Sub

    Dim thisLoan As New LoanData
    thisLoan.Populate thisLoanNumber

    If Not AllLoans.Exists(thisLoan.LoanNumber) Then
        AllLoans.Add thisLoan.LoanNumber, thisLoan
    Else
        AllLoans(thisLoan.LoanNumber) = thisLoan
        Debug.Print thisLoan.LoanNumber
    End If

End Sub
Sub ShowLoans()
    If AllLoans Is Nothing Then
        Debug.Print "This is no loan dictionary!"
    Else
        If AllLoans.Count = 0 Then
            Debug.Print "There is a loan dictionary, but it's empty!"
        Else
            Debug.Print "There are " & AllLoans.Count & " loans in the dictionary:"
            Dim loan As Variant
            For Each loan In AllLoans.Items
            Debug.Print "Loan Number: " & loan.LoanNumber & " Notes: " & loan.Notes
            Next loan
        End If
    End If

End Sub

Option Explicit
Private Sub Worksheet_Activate()
    CreateLoanDictionary
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    Dim lnNotes As Range
    Set lnNotes = Sheet1.Range("LoanNotes")

    Dim NotesChangedCells As Range
    Set NotesChangedCells = Intersect(Target, lnNotes)
    If Not NotesChangedCells Is Nothing Then
        Dim changedCell As Range
        For Each changedCell In NotesChangedCells
            UpdateLoanDictionary lnNum
        Next changedCell
    End If


    Dim rgCells As Range
    Set rgCells = Me.Range("pNames")

    Dim rgSel As Range
    Set rgSel = Intersect(Target, rgCells)

    Dim cell As Range

    If Not rgSel Is Nothing Then
        For Each cell In rgSel
            Select Case LCase(cell.Value)
                Case Is = "zack", "terri", "hunter"
                    Dim oLoan As New LoanData
                    With oLoan
                        .LoanAmount = Format(Trim(cell.Offset(0, 14).Value), "Currency")
                        .CloseDate = Trim(cell.Offset(0, 8).Value)
                        .Notes = Trim(cell.Offset(0, 17).Value)
                        .LoanNumber = Trim(cell.Offset(0, -2).Value)
                        .Product = Trim(cell.Offset(0, 15).Value)
                        .PurchasePrice = Format(Trim(cell.Offset(0, 13).Value), "Currency")
                        .TitleCompany = Trim(cell.Offset(0, 2).Value)
                        .CustomerName = Trim(Split(cell.Offset(0, -1).Value, " - ")(0))
                        .Processor = Trim(cell.Offset(0, 0).Value)
                        If .LoanAmount = "" Or .Product = "" Or .CloseDate = "" Or .Notes = vbNullString Then
                            MsgBox "Sorry, but you need to provide a minimum of:" & vbCrLf & _
                                   "Loan Amount" & vbCrLf & _
                                   "Product" & vbCrLf & _
                                   "Closing Date:" & vbCrLf & _
                                   "Interest Rate:" & vbCrLf & _
                                   "In order to assign a loan processor.", vbOKOnly + vbCritical
                        Else
                            CreateEmail oLoan.Processor, oLoan.CustomerName, oLoan.TitleCompany, oLoan.CloseDate, _
                                        oLoan.PurchasePrice, oLoan.LoanAmount, oLoan.Product, oLoan.Notes
                        End If
                    End With
            End Select
        Next cell
    End If

End Sub
我终于明白了。当单元格T5值更改时，我没有将单元格T5的偏移量作为字典的键传递，这导致单元格T5成为新键，而不是基于A5键更新字典中的项

下面是我在
工作表\u Change
事件中更改的内容，现在它相应地更新了类模块和字典

Option Explict

Dim lnNotes As Range
Set lnNotes = Sheet1.Range("LoanNotes")

Dim NotesChangedCells As Range
Set NotesChangedCells = Intersect(Target, lnNotes)
If Not NotesChangedCells Is Nothing Then
    Dim changedCell As Range
    Dim lnNum As Range
    Set lnNum = NotesChangedCells.Offset(0, -19)
    For Each changedCell In NotesChangedCells
        UpdateLoanDictionary lnNum
    Next changedCell
End If

Set AllLoans（thisLoan.LoanNumber）=thisLoan
@TimWilliams似乎仍在更新T5键，而没有更新A5键的项目。也许我没有正确地在
showloands
Sub中打印钥匙，而在即时窗口中得到了错误的信息？你在这里使用的是Watch窗口吗？当使用它来调试字典问题时，您需要非常小心-它可以从手表中自动创建条目…您何时以及如何调用
updateLocationary
？似乎你在某个时候进入了错误的范围。我没有使用手表窗口。我在
CreateLoanDictionary
过程中调用
updateAndictionary
。