按街道名称列出的VBA组属性

我有一段代码在一个范围内循环，并检查上面的单元格是否与当前单元格匹配

当它在当前单元格上方找到其他单元格时，插入一行，并将街道名称添加到“a”列，然后继续

我遇到的问题是它需要一段时间来处理，你能建议一种不同的方法吗

这是我目前使用的代码

headingRange = wb.SCAA.cells(Rows.count, lastCol + 2).End(xlUp).Row
For headingID = headingRange To 7 Step -1
    lookupval = wb.SCAA.cells(headingID, lastCol + 2)
    With cells(headingID, lastCol + 2)
        If lookupval <> .Offset(-1) Then
            .EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
            With cells(headingID, 1)
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlCenter
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .Font.bold = True
                .Font.Underline = xlUnderlineStyleSingle
                .IndentLevel = 0
            End With
        cells(headingID, 1) = wb.SCAA.cells(headingID + 1, lastCol + 2)
        End If
    End With
Next headingID

headingRange=wb.SCAA.cells（Rows.count，lastCol+2）。End（xlUp）。Row
对于headingID=headingRange至7步骤-1
lookupval=wb.SCAA.cells（headingID，lastCol+2）
带单元格（headingID，lastCol+2）
如果lookupval.Offset（-1），则
.EntireRow.Insert，CopyOrigin:=XLFormatFromRight或Low
带单元格（headingID，1）
.HorizontalAlignment=xlLeft
.垂直对齐=xlCenter
.ShrinkToFit=False
.ReadingOrder=xlContext
.Font.bold=True
.Font.Underline=xlUnderlineStyleSingle
.1级别=0
以
单元格（headingID，1）=wb.SCAA.单元格（headingID+1，lastCol+2）
如果结束
以
下一个人头

下面是我正在尝试处理的数据的示例屏幕截图

这就是数据分组后的外观

按要求，这是整个潜艇

Dim wb As Workbook: Set wb = ThisWorkbook
Dim lastRowWIR, lastRowPH, lastRowCODES, lastRow, lastCol As Long
Dim address, worktypeHeading, worktype_Valuation, headingID, headingRange, i As Long
Dim add_range_PH As Range, wID_range_PH As Range, sum_range_PH, sub_range_PH As Range
Dim add_range As Range, wID_range As Range, sum_range, sub_range As Range
Dim RangeCodes, RangeWIR, RangePH
Dim contract_total As Integer
Dim myRange As Range
Dim accountCode As Object: Set accountCode = CreateObject("Scripting.Dictionary")
Dim CodeList As Object: Set CodeList = CreateObject("Scripting.Dictionary")
Dim addressList As Object: Set addressList = CreateObject("Scripting.Dictionary")
Dim addressAFA As Object: Set addressAFA = CreateObject("Scripting.Dictionary")
Dim addressValuation As Object: Set addressValuation = CreateObject("Scripting.Dictionary")
Dim addressValuationTotal As Object: Set addressValuationTotal = CreateObject("Scripting.Dictionary")
Dim ContractList As Object: Set ContractList = CreateObject("Scripting.Dictionary")
Dim PHElementTotal As Object: Set PHElementTotal = CreateObject("Scripting.Dictionary")

'''' TEST IF THE WORKS INSTRUCTION RECORD AND PAYMENT HISTORY HAVE FILTERS APPLIED, IF TRUE THEN REMOVE THEM
If wb.WIR.FilterMode = True Then wb.WIR.AutoFilter.ShowAllData
If wb.PH.FilterMode = True Then wb.PH.AutoFilter.ShowAllData

'''' CALL THE PROGRESS USERFORM SUBROUTINE
Call UserFrmProgressSub("Currently Producing Statement for: " & wb.SCAA.cells(2, 2).value, False)

'''' DO THE FIRST DEFINE FOR LAST ROWS IN DIFFERENT SHEETS, AND LAST COLUMN
lastCol = wb.SCAA.cells(6, columns.count).End(xlToLeft).Column
lastRowWIR = wb.WIR.cells(Rows.count, WIR_AccountWorktypeID).End(xlUp).Row
lastRowPH = wb.PH.cells(Rows.count, "C").End(xlUp).Row
lastRowCODES = wb.CODES.cells(Rows.count, "F").End(xlUp).Row

'''' SET THE RANGE FOR THE EMAILIST DICTIOANARY CREATION
RangePH = wb.PH.Range("C2:H" & lastRowPH).value
RangeCodes = wb.CODES.Range("F3:G" & lastRowCODES).value
RangeWIR = wb.WIR.Range(wb.WIR.cells(3, WIR_AddressCode), wb.WIR.cells(lastRowWIR, WIR_ULRecharge)).value

'''' CREATE A SCRIPTING DICTIONARY TO HOLD THE ACCOUNT CODES (KEY:C, VALUE:CYCLICAL)
For i = LBound(RangeCodes) To UBound(RangeCodes, 1)
    '''' IF THE SUBCONTRACTOR IS NOT IN THE DICTIONARY THEN ADD IT
    If Not accountCode.exists(RangeCodes(i, 1)) Then accountCode.add RangeCodes(i, 1), RangeCodes(i, 2)
Next i

'''' CRAEATE MULTIPLE DICTIONARYS FROM THE WORKS INSTRUCTION RECORD
For i = LBound(RangeWIR) To UBound(RangeWIR, WIR_AddressCode)
    '''' ONLY ADD ITEMS TO THE RELEVANT DICTONARY IF THE SUBCONTRACTOR MATCHES THE SELECTED
    If RangeWIR(i, WIR_SubContractor) = cells(2, 2) Then
        '''' PRODUCE A CODE LIST FROM THE WIR BASED ON THE ACCOUNT WORKTYPE ID, THEN GET THE MATCHING VALUE FROM THE ACCONTCODE LIST KEYS FROM WIR, VALUE FROM CODELIST(KEY:L, VALUE:LIFECYLCE)
        If Not CodeList.exists(RangeWIR(i, WIR_AccountWorktypeID)) Then CodeList.add RangeWIR(i, WIR_AccountWorktypeID), accountCode(RangeWIR(i, WIR_AccountWorktypeID))
        '''' CREATE AND ADDRESS LIST WITH THE ADDRESS AS THE KEY, CONTACT, STREET AND PROPERTY NUMBER MAKE UP THE VALUE
        If Not addressList.exists(RangeWIR(i, WIR_AddressCode)) Then addressList.add RangeWIR(i, WIR_AddressCode), RangeWIR(i, WIR_Contract) & "|" & RangeWIR(i, WIR_Street) & "|" & Left(RangeWIR(i, WIR_AddressCode), InStr(RangeWIR(i, WIR_AddressCode), " "))
        '''' CREATE A DICTIONARY FOR THE CONTRACTS, EITHER PFI1, PFI2 OR BOTH
        If Not ContractList.exists(RangeWIR(i, WIR_Contract)) Then ContractList.add RangeWIR(i, WIR_Contract), RangeWIR(i, WIR_Contract)
        '''' DEFINE THE KEYS USED FOR THE ADDRESSAFA DICTONARY ADDRESS AND ACCOUNTWORKTYPE (14 ALMORAH ROAD|CYCLICAL)
        key = RangeWIR(i, WIR_AddressCode) & "|" & CodeList(RangeWIR(i, WIR_AccountWorktypeID))
        '''' THE ADDRESSAFA IS THE KEY AND THE RML ORDER VALUE FOR THAT ADDRESS AND CODE
        If Not addressAFA.exists(key) Then '''' IF THAT KEY IS NOT ALREADY IN THE DICTIONARY THE ADD IT WITH THE VALE
            addressAFA.add key, Round(RangeWIR(i, WIR_RMLOrderValue), 2)
        Else    '''' IF THE KEY IS IN THE DICTIONATY THE ADD THE NEW VALUE WITH WHATS ALREADY IN THE DICTIONARY
            addressAFA(key) = addressAFA(key) + Round(RangeWIR(i, WIR_RMLOrderValue), 2)
        End If
    End If
Next i

'''' CRAEATE MULTIPLE DICTIONARYS FROM THE PAYMENT HISTORY
For i = LBound(RangePH) To UBound(RangePH, 1)
    If RangePH(i, 2) = cells(2, 2) Then
        key = RangePH(i, 1) & "|" & CodeList(RangePH(i, 3))
        '''' TOTAL VALUE FOR ADDRESS & ELEMTENT (CYCLICAL)
        If Not addressValuation.exists(key) Then
            addressValuation.add key, Round(RangePH(i, 6), 2)
        Else
            addressValuation(key) = addressValuation(key) + Round(RangePH(i, 6), 2)
        End If
        '''' TOTAL VALUE FOR ADDRESS
        If Not addressValuationTotal.exists(RangePH(i, 1)) Then
            addressValuationTotal.add RangePH(i, 1), Round(RangePH(i, 6), 2)
        Else
            addressValuationTotal(RangePH(i, 1)) = addressValuationTotal(RangePH(i, 1)) + Round(RangePH(i, 6), 2)
        End If
        '''' PRODUCE A CODE LIST FROM THE WIR BASED ON THE ACCOUNT WORKTYPE ID, THEN GET THE MATCHING VALUE FROM THE ACCONTCODE LIST KEYS FROM WIR, VALUE FROM CODELIST(KEY:L, VALUE:LIFECYLCE)
        If Not PHElementTotal.exists(accountCode(RangePH(i, 3))) Then
            PHElementTotal.add accountCode(RangePH(i, 3)), Round(RangePH(i, 6), 2)
        Else
            PHElementTotal(accountCode(RangePH(i, 3))) = PHElementTotal(accountCode(RangePH(i, 3))) + Round(RangePH(i, 6), 2)
        End If
        If Not PHElementTotal.exists("Total") Then
            PHElementTotal.add "Total", Round(RangePH(i, 6), 2)
        Else
            PHElementTotal("Total") = PHElementTotal("Total") + Round(RangePH(i, 6), 2)
        End If
    End If
Next i

'''' SET THE ACCOUNTCODE DICTIONATY TO NOTHING TO FREE MEMORY (NOT USED AGAIN IN ROUTINE)
Set accountCode = Nothing

'''' TEST IF THE CODELIST HAS A COUNT OF 0, IF TRUE THE SUBCONTRACTO HAD NO WORK ISSUED TO THEN AND NOTHING PAID TO THEN. EXIT THE SUB
If CodeList.count = "0" Then
    MsgBox wb.SCAA.cells(2, 2).value & " has had no works issued to them." & vbLf & "A statement cannot be produced!", vbCritical, "SubContractor Statement Error"
    Exit Sub
End If

'''' CLEAR THE SHEET BEFORE STARTING
wb.SCAA.Rows("4:" & wb.SCAA.cells(Rows.count, lastCol).End(xlUp).Row + 10).Clear

'''' CALL THE SUBROUTINE TO CREATE THE SHEET HEADINGS
Call createSCAccountHeadings1(CodeList.count, CodeList)

'''' REDEFINE THE LAST COLUMN AFTER THE HEADINGS HAVE BEEN CREATED
lastCol = wb.SCAA.cells(6, columns.count).End(xlToLeft).Column

'''' LOOP OVER THE ADDRESS LIST, AND SPLIT THE ITEM, TO ADD THE ADDRESS, PFI, PROPERTY NUMBER AND STREET TO SHEET
tableStart = 7
For Each key In addressList.keys
    wb.SCAA.cells(tableStart, 1) = key
    wb.SCAA.cells(tableStart, 2) = Split(addressList(key), "|")(0)
    wb.SCAA.cells(tableStart, lastCol + 2) = Split(addressList(key), "|")(1)
    wb.SCAA.cells(tableStart, lastCol + 1) = Split(addressList(key), "|")(2)
    tableStart = tableStart + 1
Next key

'''' DEFINE THE LASTROW
lastRow = wb.SCAA.cells(Rows.count, 1).End(xlUp).Row

'''' APPLY INDENTS TO THE ADDRESS'S AND AUTOFIT COLUMN 1
wb.SCAA.Range("A7:A" & lastRow).InsertIndent 2
wb.SCAA.columns(1).AutoFit

'''' SET THE RANGES IN FOR THE SUM IF FUNCTIONS USED.
Set add_range = wb.WIR.columns(WIR_AddressCode)
Set wID_range = wb.WIR.columns(WIR_AccountWorktypeID)
Set sub_range = wb.WIR.columns(WIR_SubContractor)
Set sum_range = wb.WIR.columns(WIR_RMLOrderValue)
Set add_range_PH = wb.PH.Range("C:C")
Set wID_range_PH = wb.PH.Range("E:E")
Set sub_range_PH = wb.PH.Range("D:D")
Set sum_range_PH = wb.PH.Range("H:H")

'''' DEFINE MYRANGE
Set myRange = Range(cells(3, 1), cells(lastRow, lastCol))

'''' LOOP OVER THE ADDRESS AND WORKTYPE(COLUMNS), AND ADD VALUES AND FORMULAS
For address = 7 To lastRow
addressIns = wb.SCAA.cells(address, 1).value
    For worktypeHeading = 3 To myRange.columns.count
    Set wtHeading = wb.SCAA.cells(6, worktypeHeading)
        Select Case True
            Case worktypeHeading - 2 <= CodeList.count
                If IsEmpty(addressAFA(addressIns & "|" & wtHeading)) Then
                    wb.SCAA.cells(address, worktypeHeading) = 0
                Else
                    wb.SCAA.cells(address, worktypeHeading) = Format(addressAFA(addressIns & "|" & wtHeading), "Standard")
                End If
                wb.SCAA.cells(address, worktypeHeading).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
            Case worktypeHeading - 2 = CodeList.count + 1
                wb.SCAA.cells(address, worktypeHeading).value = Round(Application.WorksheetFunction.Sum(Range(cells(address, 3), cells(address, worktypeHeading - 1))), 2)
                wb.SCAA.cells(address, worktypeHeading).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
            Case worktypeHeading - 2 = CodeList.count + 2
                If cells(address, worktypeHeading - 1) = "0" And (addressValuationTotal(addressIns) = "0" Or IsEmpty(addressValuationTotal(addressIns))) Then
                    wb.SCAA.cells(address, worktypeHeading).value = "0"
                Else
                    wb.SCAA.cells(address, worktypeHeading).value = addressValuationTotal(addressIns) / cells(address, worktypeHeading - 1)
                End If
                wb.SCAA.cells(address, worktypeHeading).NumberFormat = "0.00%"
                wb.SCAA.cells(address, "AAA").value = wb.SCAA.cells(address, worktypeHeading)
                wb.SCAA.columns(worktypeHeading).AutoFit
            Case worktypeHeading - 2 > CodeList.count And worktypeHeading - 2 < myRange.columns.count - 2
                If IsEmpty(addressValuation(addressIns & "|" & wtHeading)) Then
                    totalValuation = 0
                Else
                    totalValuation = addressValuation(addressIns & "|" & wtHeading)
                End If
                myformula = "=Round(IF(" & cells(address, (worktypeHeading - (CodeList.count + 2))).address(False, False) & "=" & totalValuation & "," & totalValuation & "," & "SUM(" & cells(address, (worktypeHeading - (CodeList.count + 2))).address(False, False) & "*" & cells(address, CodeList.count + 4).address(False, False) & ")),2)"
                wb.SCAA.cells(address, worktypeHeading).formula = myformula
                wb.SCAA.cells(address, worktypeHeading).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
            Case worktypeHeading - 2 = myRange.columns.count - 2
                wb.SCAA.cells(address, lastCol).formula = "=round(sum(" & cells(address, 5 + CodeList.count).address(False, False) & ":" & cells(address, worktypeHeading - 1).address(False, False) & "),2)"
                wb.SCAA.cells(address, lastCol).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
        End Select
    Next worktypeHeading
Next address

'''' SET THE BELOW SCRIPTING DICTIONARYS TO NOTHING, TO FREE MEMORY
Set addressList = Nothing
Set addressAFA = Nothing
Set addressValuation = Nothing
Set addressValuationTotal = Nothing

'''' REDEFINE THE LAST ROW
lastRow = wb.SCAA.cells(Rows.count, "A").End(xlUp).Row

'''' TRANSPOSE THE CONTRACT LIST ON TO THE SHEET UNDER THE ADDRESS
wb.SCAA.Range("B" & lastRow + 2).Resize(ContractList.count, 1) = WorksheetFunction.Transpose(ContractList.keys)

'''' SORT THE CONTRACT LIST A - Z
If ContractList.count <> 1 Then wb.SCAA.Range("B" & lastRow + 2 & ":B" & lastRow + 2 + (ContractList.count - 1)).Sort Key1:=cells(lastRow + 2, 2), Order1:=xlAscending, Header:=xlNo

'''' DEFINE THE LAST ROW IN COLUMN B
lastRowB = wb.SCAA.cells(Rows.count, "B").End(xlUp).Row

'''' ADD "TOTAL" TO THE SHEET
wb.SCAA.cells(lastRowB + 2, 2) = "TOTAL"

'''' LOOP OVER THE CONTRACT LIST AT BOTTOM AND TOTAL, AND ADD FORMULAS THERE APPRIOPRIATE
For contract_total = lastRow + 2 To lastRowB + 2
    For worktypeHeading = 3 To myRange.columns.count
    Set wtHeading = wb.SCAA.cells(6, worktypeHeading)
    If contract_total = lastRowB + 1 Then Exit For
    If wtHeading.Offset(-1) <> "PROGRESS" Then
        If contract_total <> lastRowB + 2 Then
            wb.SCAA.cells(contract_total, worktypeHeading).formula = "=round(sumif(" & cells(7, 2).address & ":" & cells(lastRow, 2).address & "," & cells(contract_total, 2).address & "," & cells(7, worktypeHeading).address & ":" & cells(lastRow, worktypeHeading).address & "),2)"
            wb.SCAA.cells(contract_total, worktypeHeading).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
        Else
            wb.SCAA.cells(lastRowB + 2, worktypeHeading).formula = "=round(Sum(" & cells(lastRowB - 1, worktypeHeading).address & ":" & cells(lastRowB, worktypeHeading).address & "),2)"
            wb.SCAA.cells(lastRowB + 2, worktypeHeading).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
        End If
    End If
    Next worktypeHeading
Next contract_total

'''' RE-DEFINE THE LAST ROW IN COLUMN B
lastRowB = wb.SCAA.cells(Rows.count, "B").End(xlUp).Row

'''' ADD TWO HEADINGS
wb.SCAA.cells(lastRowB + 2, 3 + CodeList.count) = "TOTAL ALREADY PAID"
wb.SCAA.cells(lastRowB + 4, 3 + CodeList.count) = "TOTAL CHANGED"

'''' ADD THE FORMULAS TO THE TOTAL ALDREAY PAID, AND TOTAL CHANGED
For worktype_Valuation = CodeList.count + 5 To myRange.columns.count
    worktype_value = wb.SCAA.cells(6, worktype_Valuation)
    If IsEmpty(PHElementTotal(worktype_value)) Or PHElementTotal(worktype_value) = 0 Then
        tempTotal = 0
    Else
        tempTotal = PHElementTotal(worktype_value)
    End If
    If worktype_value <> "Total" Then
        wb.SCAA.cells(lastRowB + 2, worktype_Valuation) = tempTotal
        wb.SCAA.cells(lastRowB + 2, worktype_Valuation).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
        wb.SCAA.cells(lastRowB + 4, worktype_Valuation).formula = "=round(sum(" & cells(lastRowB, worktype_Valuation).address & ":" & cells(lastRowB, worktype_Valuation).address & ",-" & cells(lastRowB + 2, worktype_Valuation).address & "),2)"
        wb.SCAA.cells(lastRowB + 4, worktype_Valuation).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
    Else
        wb.SCAA.cells(lastRowB + 2, worktype_Valuation) = tempTotal
        wb.SCAA.cells(lastRowB + 2, worktype_Valuation).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
        wb.SCAA.cells(lastRowB + 4, worktype_Valuation).formula = "=round(sum(" & cells(lastRowB, worktype_Valuation).address & ":" & cells(lastRowB, worktype_Valuation).address & ",-" & cells(lastRowB + 2, worktype_Valuation).address & "),2)"
        wb.SCAA.cells(lastRowB + 4, worktype_Valuation).NumberFormat = "#,##0.00_ ;[Red](#,##0.00)"
    End If
Next worktype_Valuation

Set PHElementTotal = Nothing

'''' CALL THE SORTING SUB ROUTINE
Call sortData(wb.SCAA, 7, (lastRow), (lastCol + 2), False, (lastCol + 1))

'''' LOOP OVER THE ROWS, AND SEPERATE THE ADDRESS INTO SREETS
headingRange = wb.SCAA.cells(Rows.count, lastCol + 2).End(xlUp).Row
For headingID = headingRange To 7 Step -1
    lookupval = wb.SCAA.cells(headingID, lastCol + 2)
    With cells(headingID, lastCol + 2)
        If lookupval <> .Offset(-1) Then
            .EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
            With cells(headingID, 1)
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlCenter
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .Font.bold = True
                .Font.Underline = xlUnderlineStyleSingle
                .IndentLevel = 0
            End With
        cells(headingID, 1) = wb.SCAA.cells(headingID + 1, lastCol + 2)
        End If
    End With
Next headingID

'''' ONCE ADDRESS'S HAVE BEEN SORTED AND ADDRESS'S GROUPED INTO STREETS, CLEAR THE STREET HAS PROPERTY NUMBER IN THE LAST 2 COLUMNS
With Union(columns(lastCol + 1), columns(lastCol + 2))
    .ClearContents
End With

'''' REFINE LAST ROW: COLUMN A, AND LAST ROW B: COLUMN B
lastRowB = wb.SCAA.cells(Rows.count, "B").End(xlUp).Row
lastRow = wb.SCAA.cells(Rows.count, "A").End(xlUp).Row

'''' APPLY BORDERS TO THE SHEET, AND FORMAT
With wb.SCAA
    With Union(Range(cells(7, 1), cells(lastRow, lastCol)), _
               Range(cells(lastRowB, 2), cells(lastRowB, CodeList.count + 3)), _
               Range(cells(lastRowB, 5 + CodeList.count), cells(lastRowB, lastCol)), _
               Range(cells(lastRow + 2, 2), cells(lastRow + 1 + ContractList.count, 2 + CodeList.count + 1)), _
               Range(cells(lastRow + 2, 5 + CodeList.count), cells(lastRow + 1 + ContractList.count, lastCol)), _
               Range(cells(lastRowB + 2, 5 + CodeList.count), cells(lastRowB + 2, lastCol)), _
               Range(cells(lastRowB + 4, 5 + CodeList.count), cells(lastRowB + 4, lastCol)))
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
            With Range(cells(7, 2), cells(lastRowB, 2))
                .HorizontalAlignment = xlVAlignCenter
                .VerticalAlignment = xlVAlignCenter
            End With
            With Union(Range(cells(7, 1), cells(lastRow, 1)), _
                       Range(cells(7, 2), cells(lastRow, 2)), _
                       Range(cells(7, 4 + CodeList.count), cells(lastRow, 4 + CodeList.count)))
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlThick
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlThick
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideVertical).Weight = xlThick
            End With
    End With
End With

'''' LOOP OVER ALL THE ADDRESS'S AND APPLY CONDITIONAL FORMATTING
lastRow = wb.SCAA.cells(Rows.count, "A").End(xlUp).Row
For address = 7 To lastRow
    If IsEmpty(cells(address, 4 + CodeList.count).value) = False Then
        With wb.SCAA.Range(wb.SCAA.cells(address, 1), wb.SCAA.cells(address, lastCol))
            .FormatConditions.add Type:=xlExpression, Formula1:="=" & cells(address, 4 + CodeList.count).address(False) & ">1"
            .FormatConditions(1).Interior.Color = RGB(215, 150, 148)
            .FormatConditions(1).StopIfTrue = False
            .FormatConditions.add Type:=xlExpression, Formula1:="=" & cells(address, 4 + CodeList.count).address(False) & "<>" & wb.SCAA.cells(address, "AAA").address(False) & ""
            .FormatConditions(2).Interior.Color = RGB(196, 215, 155)
            .FormatConditions(2).StopIfTrue = False
        End With
    End If
Next address

wb.SCAA.Range(columns(2), columns(lastCol)).ColumnWidth = 14

'''' RE-DEFINE THE LAST ROW B
lastRowB = wb.SCAA.cells(Rows.count, "B").End(xlUp).Row

'''' LOCK ALL THE CELLS IN SHEET
wb.SCAA.Range(wb.SCAA.cells(1, 1), wb.SCAA.cells(lastRowB + 4, lastCol)).Locked = True

'''' UNLOCK THE PROGRESS COLUMN TO BE ABLE TO CHANGE THE PERCENTAGES
wb.SCAA.Range(wb.SCAA.cells(7, 4 + CodeList.count), wb.SCAA.cells(wb.SCAA.cells(Rows.count, "A").End(xlUp).Row, 4 + CodeList.count)).Locked = False

'''' SET CONTRACT LIST AND CODE LIST TO NOTHING TO AVOID MEMORY LEAKS
Set ContractList = Nothing
Set CodeList = Nothing

Dim wb As工作簿：Set wb=thiswoolk
将lastRowWIR、lastRowPH、lastRowCODES、lastRow、lastCol变暗为长
Dim地址、工作类型标题、工作类型估值、标题ID、标题范围、i长度
尺寸添加范围作为范围，宽度范围作为范围，总和范围作为范围，子范围作为范围
Dim add_range As range、wID_range As range、sum_range、sub_range As range
变暗范围代码、RangeWIR、RangePH
Dim合同\u总计为整数
将myRange变暗为Range
将accountCode设置为对象：设置accountCode=CreateObject（“Scripting.Dictionary”）
Dim CodeList As Object:Set CodeList=CreateObject（“Scripting.Dictionary”）
Dim addressList As Object:Set addressList=CreateObject（“Scripting.Dictionary”）
Dim addressAFA作为对象：设置addressAFA=CreateObject（“Scripting.Dictionary”）
Dim addressValuation As Object:设置addressValuation=CreateObject（“Scripting.Dictionary”）
Dim addressValuationTotal作为对象：设置addressValuationTotal=CreateObject（“Scripting.Dictionary”）
Dim ContractList As Object:Set ContractList=CreateObject（“Scripting.Dictionary”）
Dim PHElementTotal作为对象：设置PHElementTotal=CreateObject（“Scripting.Dictionary”）
''''测试工作指令记录和付款历史记录是否应用了筛选器，如果为TRUE，则将其删除
如果wb.WIR.FilterMode=True，则wb.WIR.AutoFilter.ShowAllData
如果wb.PH.FilterMode=True，则wb.PH.AutoFilter.ShowAllData
''调用PROGRESS USERFORM子例程
调用userfrmprogressub（“当前正在生成语句：”&wb.SCAA.cells（2,2）.value，False）
''为不同工作表中的最后一行和最后一列定义第一行
lastCol=wb.SCAA.cells（6，columns.count）.End（xlToLeft）.Column
lastRowWIR=wb.WIR.cells（Rows.count，WIR\u AccountWorktypeID）.End（xlUp）.Row
lastRowPH=wb.PH.cells（Rows.count，“C”）.End（xlUp）.Row
lastRowCODES=wb.CODES.cells（Rows.count，“F”）.End（xlUp）.Row
''设置电子邮件列表词汇创建的范围
RangePH=wb.PH.Range（“C2:H”和lastRowPH）.值
RangeCodes=wb.CODES.Range（“F3:G”和lastRowCODES）.值
RangeWIR=wb.WIR.Range（wb.WIR.cells（3，WIR\u地址代码），wb.WIR.cells（lastRowWIR，WIR\u地址代码））.value
''''创建脚本字典以保存帐户代码（键：C，值：C）
对于i=LBound（范围码）到UBound（范围码，1）
''如果分包商不在字典中，则添加它
如果accountCode.不存在（范围代码（i，1）），则accountCode.add范围代码（i，1）、范围代码（i，2）
接下来我
''从工作指令记录中创建多个词典
对于i=LBound（RangeWIR）到UBound（RangeWIR，WIR\u地址码）
''仅当分包商与所选项目匹配时，才将项目添加到相关目录中
如果RangeWIR（i，WIR_）=单元格（2，2），则
''根据帐户工作类型ID从WIR生成代码列表，然后从WIR的ACCONTCODE列表键中获取匹配值，从代码列表中获取值（键：L，值：LIFECYLCE）
如果不存在CodeList.exists（RangeWIR（i，WIR\u AccountWorktypeID）），则CodeList.add RangeWIR（i，WIR\u AccountWorktypeID）、accountCode（RangeWIR（i，WIR\u AccountWorktypeID））
''创建地址列表，地址作为键，联系人、街道和财产编号构成值
如果地址列表不存在（RangeWIR（i，WIR_地址代码）），则地址列表添加RangeWIR（i，WIR_地址代码），RangeWIR（i，WIR_合同）和“|”&RangeWIR（i，WIR_街道）和“|”&左（RangeWIR（i，WIR_地址代码），InStr（RangeWIR（i，WIR_地址代码），“”）
''为合同创建字典，PFI1、PFI2或两者
如果不存在ContractList.exists（RangeWIR（i，WIR_合同）），则ContractList.add RangeWIR（i，WIR_合同），RangeWIR（i，WIR_合同）
''定义用于AddressA口述地址和ACCOUNTWORKTYPE的键（阿尔莫拉路14号|循环）
key=RangeWIR（i，WIR_AddressCode）&“|”和代码列表（RangeWIR（i，WIR_AccountWorktypeID））
''''ADDRESSAFA是该地址和代码的键和RML顺序值
如果addressAFA.exists（key）不存在，则“”如果该key不在字典中，则将其与VALE一起添加
地址afa.add键，圆形（RangeWIR（i，WIR_RMLOrderValue），2）
否则“”，如果键在字典中，则使用字典中已有的内容添加新值
addressAFA（键）=addressAFA（键）+舍入（RangeWIR（i，WIR_RMLOrderValue），2）
如果结束
如果结束
接下来我
''从支付历史记录中创建多个词典
对于i=LBound（RangePH）到UBound（RangePH，1）
如果RangePH（i，2）=单元格（2，2），则
key=RangePH（i，1）&“|”和代码列表（RangePH（i，3））