时间戳

首页 > 解决方案 > VBA：将字典转换为数组以加快处理速度

arrays - VBA：将字典转换为数组以加快处理速度

问题描述

我创建了一个包含 4000 多个键和多个项目的字典，但是将这个字典传递到工作表上非常耗时且效率低下。我对此进行了研究，似乎传递给数组然后字典会更快，因为使用内存是有意义的。

该过程在下面调用。

Sub Dictionary()

Dim dict As Dictionary

Set dict = ReadData()

Call WriteDict(dict)

End Sub

这将创建字典并填充自定义类模块

Function ReadData()


Dim dict As New Dictionary

Dim DataWs As Worksheet: Set DataWs = ThisWorkbook.Sheets("DATA")
Dim PoolOfWeekWs As Worksheet: Set PoolOfWeekWs = ThisWorkbook.Sheets("Pool of the week")

Dim range As range: Set range = DataWs.range("A1").CurrentRegion

Dim i As Long
Dim CandidateProcessID As String, CandidateName As String, FirstName As String, ProcessStatus As String, FirstITWDate As String, PQLDate As String, XP As String, oCandidate As ClsCandidate

For i = 2 To range.Rows.Count
    If range.Cells(i, 35).Value <> "NOK" Then
    
        ProcessStatus = range.Cells(i, 9).Value
        If range.Cells(i, 13).Value = "Prequalification" Then PQLDate = range.Cells(i, 11).Value
        ProcessType = range.Cells(i, 35).Value
        InterviewScore = range.Cells(i, 37).Value
        CandidateName = range.Cells(i, 16).Value
        FirstName = range.Cells(i, 17).Value
        NameofCM = range.Cells(i, 44).Value
        If range.Cells(i, 13) = "Candidate Interview 1" Then FirstITWDate = range.Cells(i, 11).Value
        BM1ITW = range.Cells(i, 44).Value
        DetailedSkills = range.Cells(i, 28).Value
        SkillsSummary = range.Cells(i, 29).Value
        Sector = range.Cells(i, 49).Value
        XP = range.Cells(i, 24).Value
        NP = range.Cells(i, 30).Value
        Nationality = range.Cells(i, 39).Value
        SalaryExpectation = range.Cells(i, 48).Value
        ProposedSalary = range.Cells(i, 48).Value
        If range.Cells(i, 13) = "Candidate Interview 2+" Then SecondITWDate = range.Cells(i, 11).Value
        If range.Cells(i, 13) = "Candidate Interview 2*" Then PPLDate = range.Cells(i, 11).Value
        Email = range.Cells(i, 18).Value
        PhoneNum = range.Cells(i, 19).Value
        ROName = range.Cells(i, 46).Value
        'BusinessUnitName
        'RecruitmentOfficerBusinessUnit
        'RecruiterTreegram
        'LookupyearsExperience
        
        CandidateProcessID = range.Cells(i, 10).Value
        
        If range.Cells(i, 13) = "Signature Interview" Then SignatureInterview = range.Cells(i, 11).Value
             
    If dict.Exists(CandidateProcessID) = True Then
        Set oCandidate = dict(CandidateProcessID)
        
        oCandidate.ProcessStatus = oCandidate.ProcessStatus
        oCandidate.PQLDate = oCandidate.PQLDate
        oCandidate.ProcessType = oCandidate.ProcessType
        oCandidate.InterviewScore = oCandidate.InterviewScore
        oCandidate.CandidateName = oCandidate.CandidateName
        oCandidate.FirstName = oCandidate.FirstName
        oCandidate.NameofCM = oCandidate.NameofCM
        oCandidate.FirstITWDate = oCandidate.FirstITWDate
        oCandidate.BM1ITW = oCandidate.BM1ITW
        oCandidate.DetailedSkills = oCandidate.DetailedSkills
        oCandidate.SkillsSummary = oCandidate.SkillsSummary
        oCandidate.Sector = oCandidate.Sector
        oCandidate.YearsExp = oCandidate.YearsExp
        oCandidate.NP = oCandidate.NP
        oCandidate.Nationality = oCandidate.Nationality
        oCandidate.SalaryExpectation = oCandidate.SalaryExpectation
        oCandidate.ProposedSalary = oCandidate.ProposedSalary
        oCandidate.SecondITWDate = oCandidate.SecondITWDate
        oCandidate.PPLDate = oCandidate.PPLDate
        oCandidate.Email = oCandidate.Email
        oCandidate.PhoneNum = oCandidate.PhoneNum
        oCandidate.ROName = oCandidate.ROName
       
    Else
        Set oCandidate = New ClsCandidate
        dict.Add CandidateProcessID, oCandidate
        
        oCandidate.ProcessStatus = oCandidate.ProcessStatus + ProcessStatus
        oCandidate.PQLDate = oCandidate.PQLDate + PQLDate
        oCandidate.ProcessType = oCandidate.ProcessType + ProcessType
        oCandidate.InterviewScore = oCandidate.InterviewScore + InterviewScore
        oCandidate.CandidateName = oCandidate.CandidateName + CandidateName
        oCandidate.FirstName = oCandidate.FirstName + FirstName
        oCandidate.NameofCM = oCandidate.NameofCM + NameofCM
        oCandidate.FirstITWDate = oCandidate.FirstITWDate + FirstITWDate
        oCandidate.BM1ITW = oCandidate.BM1ITW + BM1ITW
        oCandidate.DetailedSkills = oCandidate.DetailedSkills + DetailedSkills
        oCandidate.SkillsSummary = oCandidate.SkillsSummary + SkillsSummary
        oCandidate.Sector = oCandidate.Sector + Sector
        oCandidate.YearsExp = oCandidate.YearsExp + YearsExp
        oCandidate.NP = oCandidate.NP + NP
        oCandidate.Nationality = oCandidate.Nationality + Nationality
        oCandidate.SalaryExpectation = oCandidate.SalaryExpectation + SalaryExpectation
        oCandidate.ProposedSalary = oCandidate.ProposedSalary + ProposedSalary
        oCandidate.SecondITWDate = oCandidate.SecondITWDate + SecondITWDate
        oCandidate.PPLDate = oCandidate.PPLDate + PPLDate
        oCandidate.Email = oCandidate.Email + Email
        oCandidate.PhoneNum = oCandidate.PhoneNum + PhoneNum
        oCandidate.ROName = oCandidate.ROName + ROName
    End If
    
    End If

Next i

Set ReadData = dict


End Function

下面将数据写入工作表

Sub WriteDict(dict As Dictionary)

Application.ScreenUpdating = False

    Dim key, DictOutput() As Variant, oCandidate As ClsCandidate, row, TotalEntries, TotalColumns As Long, OutputRange As range
    Set rangeoutput = Sheets("Pool of the week")
    row = 1
    
    TotalEntries = dict.Count
    TotalColumns = 22
    DictOutput = dict.Items()
    
Application.ScreenUpdating = True

End Sub

首先，我尝试使用上述方法简单地将字典传递给数组。但是，它不会以与字典相同的顺序（按字母顺序）从类模块中添加字典项，这是我首先创建字典以重新排列它们的原因之一。

是否可以让数组保持与字典相同的格式，如果是这样，现在传递给工作表的最佳方式是什么？会不会只是

'Psuedo code
Sheets(SHEETNAME).Range("A1").Resize(UBound(DictOutput(1)) = DictOutput

评论后 数组似乎是一维的，如屏幕截图所示。也没有按正确的顺序 从字典中获取 Array Crated 的屏幕截图

回答后编辑

For i = 2 To range.Rows.Count
    If range.Cells(i, 35).Value <> "NOK" Then
    
        If range.Cells(i, 13) = "Candidate Interview 1" Then FirstITWDate = range.Cells(i, 11).Value: BM1ITW = range.Cells(i, 5).Value
        If range.Cells(i, 49) = "Expected Gross Annual Salary" Then SalaryExpectation = range.Cells(i, 50).Value ' If column x is salary expectation take this value
        If range.Cells(i, 49) = "Proposed Gross Annual Salary (AHF)" Then ProposedSalary = range.Cells(i, 50).Value 'if column x is proposed take this value
        If range.Cells(i, 13) = "Candidate Interview 2+" Then SecondITWDate = range.Cells(i, 11).Value
        If range.Cells(i, 13) = "Candidate Interview 2*" Then PPLDate = range.Cells(i, 11).Value
        If range.Cells(i, 13).Value = "Prequalification" Then PQLDate = range.Cells(i, 11).Value
        If range.Cells(i, 13) = "Signature Interview" Then SignatureInterview = range.Cells(i, 11).Value
        
        CandidateProcessID = range.Cells(i, 10).Value
        ProcessStatus = range.Cells(i, 9).Value
        ProcessType = range.Cells(i, 35).Value
        InterviewScore = range.Cells(i, 37).Value
        CandidateName = range.Cells(i, 16).Value
        FirstName = range.Cells(i, 17).Value
        NameofCM = range.Cells(i, 44).Value
        DetailedSkills = range.Cells(i, 28).Value
        SkillsSummary = range.Cells(i, 29).Value
        Sector = range.Cells(i, 48).Value
        XP = range.Cells(i, 24).Value
        NP = range.Cells(i, 30).Value
        Nationality = range.Cells(i, 39).Value
        Mobility = range.Cells(i, 47).Value
        Email = range.Cells(i, 18).Value
        PhoneNum = range.Cells(i, 19).Value
        ROName = range.Cells(i, 46).Value
        
        'BusinessUnitName
        'RecruitmentOfficerBusinessUnit
        'RecruiterTreegram
        'LookupyearsExperience
        
        
        
        If dict.Exists(CandidateProcessID) = True Then
            Set oCandidate = dict(CandidateProcessID)
                oCandidate.ProcessStatus = ProcessStatus
                oCandidate.PQLDate = PQLDate
                oCandidate.ProcessType = ProcessType
                oCandidate.InterviewScore = InterviewScore
                oCandidate.CandidateName = CandidateName
                oCandidate.FirstName = FirstName
                oCandidate.NameofCM = NameofCM
                oCandidate.FirstITWDate = FirstITWDate
                oCandidate.BM1ITW = BM1ITW
                oCandidate.DetailedSkills = DetailedSkills
                oCandidate.SkillsSummary = SkillsSummary
                oCandidate.Sector = Sector
                oCandidate.YearsExp = YearsExp
                oCandidate.NP = NP
                oCandidate.Nationality = Nationality
                oCandidate.Mobility = Mobility
                oCandidate.SalaryExpectation = SalaryExpectation
                oCandidate.ProposedSalary = ProposedSalary
                oCandidate.SecondITWDate = SecondITWDate
                oCandidate.PPLDate = PPLDate
                oCandidate.Email = Email
                oCandidate.PhoneNum = PhoneNum
                oCandidate.ROName = ROName
        Else
            Set oCandidate = New ClsCandidate

                oCandidate.ProcessStatus = ProcessStatus
                oCandidate.PQLDate = PQLDate
                oCandidate.ProcessType = ProcessType
                oCandidate.InterviewScore = InterviewScore
                oCandidate.CandidateName = CandidateName
                oCandidate.FirstName = FirstName
                oCandidate.NameofCM = NameofCM
                oCandidate.FirstITWDate = FirstITWDate
                oCandidate.BM1ITW = BM1ITW
                oCandidate.DetailedSkills = DetailedSkills
                oCandidate.SkillsSummary = SkillsSummary
                oCandidate.Sector = Sector
                oCandidate.YearsExp = YearsExp
                oCandidate.NP = NP
                oCandidate.Nationality = Nationality
                oCandidate.Mobility = Mobility
                oCandidate.SalaryExpectation = SalaryExpectation
                oCandidate.ProposedSalary = ProposedSalary
                oCandidate.SecondITWDate = SecondITWDate
                oCandidate.PPLDate = PPLDate
                oCandidate.Email = Email
                oCandidate.PhoneNum = PhoneNum
                oCandidate.ROName = ROName
        
            dict.Add CandidateProcessID, oCandidate
        End If
        
    End If

Next i

标签： arraysexcelvbadictionary

解决方案

解决您如何填充字典：您的逻辑不正确，应该是这样的：

loop over lines
    read data from the line
    if object with line's "key" exists in the dictionary
        get reference to existing object from dictionary
        append additional information to the object's properties
    else
        create new object
        populate properties
        add to dictionary
    end if
next line

推荐阅读