0

我是 VBA 新手，我正在寻找类似于 python pandas 的东西，即避免多次循环遍历每一行。我正在尝试完成一项非常简单的任务，但它需要的时间太长了。循环的最佳替代方案是什么？

环顾四周，似乎 AutoFilter 和 Find 可能会起作用，但是我不确定在我的情况下什么是最佳选择。

Sub UpdateManualUpdates()
    Dim lookUpSheet As Worksheet, updateSheet As Worksheet
    Dim valueToSearch As String
    Dim i As Long, t As Long

    Set lookUpSheet = Worksheets("Manual price changes")
    Set updateSheet = Worksheets("Price Build-up")

    lastRowLookup = lookUpSheet.Cells(Rows.Count, "F").End(xlUp).Row
    lastRowUpdate = updateSheet.Cells(Rows.Count, "B").End(xlUp).Row
    'get the number of the last row with data in sheet1 and in sheet2

    For i = 6 To lastRowLookup 'i = 2 to last to omit the first row as that row is for headers

        valueType = lookUpSheet.Cells(i, 5) 'Type of update - Both, Planning group or GC
        valueGroup = lookUpSheet.Cells(i, 3) 'Family group
        valueGC = lookUpSheet.Cells(i, 4) 'GC
        ValueChange = lookUpSheet.Cells(i, 6) 'What is the % change
        'above get the values from the four column into variables
        With Worksheets("Price build-up")
            For t = 6 To lastRowUpdate
                'AW is column 49 target column to update
                'M is target column for group, 13
                'C is target column for GC, 3
                If valueType = "Both" Then
                    If .Cells(t, 13) = valueGroup And .Cells(t, 3) = valueGC Then
                    .Cells(t, 49) = ValueChange
                    End If
                End If
                If valueType = "Planning group" Then
                    If .Cells(t, 13) = valueGroup Then
                    .Cells(t, 49) = ValueChange
                    End If
                End If
                If valueType = "GC" Then
                    If .Cells(t, 3) = valueGC Then
                    .Cells(t, 49) = ValueChange
                    End If
                End If
            Next t
        End With
    Next i
End Sub
4

1 回答 1

0

访问和更新 Workbook 对象很慢。根据您现在所拥有的，一种简单的方法是将工作表转换为数组并从数组中读取数据。此外，设置 Application.ScreenUpdating = False 会使其更快一点。

Sub UpdateManualUpdates()
    Application.ScreenUpdating = False
    Dim lookUpSheet As Worksheet, updateSheet As Worksheet
    Dim valueToSearch As String
    Dim i As Long, t As Long

    Set lookUpSheet = Worksheets("Manual price changes")
    Set updateSheet = Worksheets("Price Build-up")

    Dim lookUpSheetArray As Variant
    Dim updateSheetArray As Variant

    lastRowLookup = lookUpSheet.Cells(Rows.Count, "F").End(xlUp).Row
    lastRowUpdate = updateSheet.Cells(Rows.Count, "B").End(xlUp).Row

    lookUpSheetArray = lookUpSheet.Range("A1:F" & lastRowLookup).Value
    updateSheetArray = updateSheet.Range("A1:AW" & lastRowUpdate).Value

    For i = 6 To lastRowLookup 'i = 2 to last to omit the first row as that row is for headers

        valueType = lookUpSheetArray(i, 5) 'lookUpSheet.Cells(i, 5) 'Type of update - Both, Planning group or GC
        valueGroup = lookUpSheetArray(i, 3) 'Family group
        valueGC = lookUpSheetArray(i, 4) 'GC
        ValueChange = lookUpSheetArray(i, 6) 'What is the % change
        'above get the values from the four column into variables

        For t = 6 To lastRowUpdate
            'AW is column 49 target column to update
            'M is target column for group, 13
            'C is target column for GC, 3
            If valueType = "Both" Then
                If updateSheetArray(t, 13) = valueGroup And updateSheetArray(t, 3) = valueGC Then
                    updateSheet.Cells(t, 49) = ValueChange
                End If
            End If
            If valueType = "Planning group" Then
                If updateSheetArray(t, 13) = valueGroup Then
                    updateSheet.Cells(t, 49) = ValueChange
                End If
            End If
            If valueType = "GC" Then
                If updateSheetArray(t, 3) = valueGC Then
                    updateSheet.Cells(t, 49) = ValueChange
                End If
            End If
        Next t
    Next i
    Application.ScreenUpdating = True
End Sub

根据我的实验，它快了大约 35%。不是很大的改进，但只需一分钟即可更新。

于 2019-06-18T03:34:46.770 回答