Question

我在一家建筑公司工作。我一直在为库存部门编写一个宏，该宏可以检索将特定类型的物料提供给现场特定单位编号的最新日期。

我拥有的代码正在完成任务，但是计算所有结果要花费很长时间。谁能告诉我如何使此过程更快。

以下是代码：

Sub FillTopSheet()
'Designing a loop to move through the fill data on Top Sheet
Application.ScreenUpdating = False

'Declaring variables for counts
Dim Flat_Row_Num As Long
Dim Tower_Col_Num As Long
Dim InventoryWs As Worksheet

'Debug.Print Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out").Name
Set InventoryWs = Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out")

Dim Lookup_Start_Row As Long
Dim Lookup_End_Row As Long

'Lookup_Start_Row = 4
'
'Select Case Application.ThisWorkbook.ActiveSheet.Name
'    Case "Kitchen Carcass"
'        Do Until InventoryWs.Cells(Lookup_Start_Row, 2).Value = "Kitchen Carcass"
'                Lookup_Start_Row = Lookup_Start_Row + 1
'        Loop
'
'        Lookup_End_Row = Lookup_Start_Row
'
'        Do While InventoryWs.Cells(Lookup_End_Row, 2).Value = "Kitchen Carcass"
'        Lookup_End_Row = Lookup_End_Row + 1
'
'        Loop
'
'        Lookup_End_Row = Lookup_End_Row - 1
'
'End Select

Debug.Print Lookup_Start_Row
Debug.Print Lookup_End_Row
Lookup_Start_Row = 6162
Lookup_End_Row = 14754

Flat_Row_Num = 5
Tower_Col_Num = 5

Do Until Tower_Col_Num > 13

    Do Until Flat_Row_Num > 154
        If Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num - 1).Value <> "" Then
            Do Until Lookup_Start_Row = Lookup_End_Row
                If Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num - 1).Value = _
                InventoryWs.Cells(Lookup_Start_Row, 8).Value Then
                    Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num).Value = _
                    InventoryWs.Cells(Lookup_Start_Row, 6).Value
                    GoTo RowReset
                Else
                    Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num).Value = "NA"
                End If

                Lookup_Start_Row = Lookup_Start_Row + 1
            Loop
            Lookup_Start_Row = 6162
RowReset:
Lookup_Start_Row = 6162
        End If
        Flat_Row_Num = Flat_Row_Num + 1
    Loop
Flat_Row_Num = 5
Tower_Col_Num = Tower_Col_Num + 2
Loop

Application.ScreenUpdating = True


End Sub

Answer 1

可能是这样，但索引（i，j，k）可能会混淆。如果您可以发布您的输入和所需的输出（例如一些屏幕截图），将会更加容易

Sub FillTopSheet()

    'Declaring variables for counts
    Dim Flat_Row_Num As Long
    Dim Tower_Col_Num As Long
    Dim InventoryWs As Worksheet, Ws As Worksheet
    Dim ArrLookUp() As Variant, ArrData() As Variant
    Dim Lookup_Start_Row As Long, Lookup_End_Row As Long, i As Long, j As Long, k As Long
    Dim FlatNo As String

    'Designing a loop to move through the fill data on Top Sheet
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Debug.Print Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out").Name
    Set InventoryWs = Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out")

    Debug.Print Lookup_Start_Row
    Debug.Print Lookup_End_Row

    Lookup_Start_Row = 6162
    Lookup_End_Row = 14754

    Flat_Row_Num = 5
    Tower_Col_Num = 2 'Start in Tower A "Flats No. column

    With InventoryWs
        ArrLookUp = .Range(.Cells(Lookup_Start_Row, 6), .Cells(Lookup_End_Row, 8))
    End With

    With Ws
        ArrData = .Range(.Cells(Flat_Row_Num, Tower_Col_Num), .Cells(154, 13))
    End With

    For i = LBound(ArrData, 2) To UBound(ArrData, 2) Step 2
        For j = LBound(ArrData) To UBound(ArrData)
            'loop through "towers" Array
            FlatNo = ArrData(j, i) 'take one flat no
            If FlatNo <> "" Then
                For k = LBound(ArrLookUp) To UBound(ArrLookUp)
                    'look for this flat no in other array
                    If FlatNo = ArrLookUp(k, 3) Then
                        'first match = take Date from other array
                        'dates sorted descending
                        ArrData(j, i + 1) = ArrLookUp(k, 1)
                        'found what was looking for, get out of loop
                        Exit For
                    End If
                Next k
            End If
        Next j
    Next i

    With Ws
        'range must be same as when you set the array earlier. But if that range contains some formulas they'll be overwriten with values
        'in that case you can loop through array and take out only dates
        .Range(.Cells(Flat_Row_Num, Tower_Col_Num), .Cells(154, 13)) = ArrData
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

编辑
仍然可能需要进行一些调整以适合您的范围
检查ArrLookUp = .Range(.Cells(Lookup_Start_Row, 6), .Cells(Lookup_End_Row, 8))和ArrLookUp = .Range(.Cells(Lookup_Start_Row, 6), .Cells(Lookup_End_Row, 8))中的范围
需要“ Towers”并要查找“ Flats No.”在另一张纸上。第一次比赛的日期取自其他表。

需要一种使Excel VBA中的循环更快的方法

1 个答案: