VBA中是否有for-if循环的替代方法？

亚历克斯·奥利里

我在Excel中有两个工作表。我已经编写了以下代码，根据用户在工作表2中插入的一些值，将一些数据从工作表1复制到工作表2。

宏可以正常工作，并且可以执行我需要做的事情，但是在将其写下来之后，我意识到了两件事：

一小套记录（大约260条）需要花费相当长的时间，因为它一次只行一行。
我读到使用.select并不是一种好习惯，并且我修改了代码以免使用它，但是我想知道如果使用它，是否可以提高代码的运行速度。

因此，我的主要问题是：

如何提高代码速度，使其能够更快地读取副本行。
在这种情况下，最好在我的情况下使用.select，这样它可以更快地工作。

我的代码如下：

Private Sub FillUp()
Dim DateVal, EquivalentDate As Date
Dim CrncyVal
Dim CountrVal
Dim DataRng As Range
Dim endrow As Long, startrow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
'Selecting the worksheets
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

''''declaring date, country and currency variables''''
DateVal = ws2.Range("E3").Value
CountryVal = UCase(ws2.Range("H3").Value)
CurrencyVal = UCase(ws2.Range("H4").Value)
EquivalentDateVal = DateAdd("yyyy", -1, DateVal)
'declaring other useful variables
startrow = 3
pasterow = 6
endrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'delete the range we will be working with
ws2.Range("A6:F265").Clear

'start the ifs, to see what info the user wants to get
If ws2.Range("E3").Value = "" Then
    'If the country cell is empty, we do nothing. We need at least this info
    MsgBox prompt:="You didn't choose a month!!", Title:="Error: Please Choose a Month"
    Exit Sub
ElseIf ws2.Range("H3").Value = "" Then
    For i = 3 To endrow
        If ws1.Cells(i, 3).Value <> "TOT" Then

            With ws1
                Set Rng = .Range(.Cells(i, 1), .Cells(i, 5))
            End With

            Rng.Copy
            ws2.Cells(pasterow, 1).PasteSpecial
            ws2.Cells(pasterow, 6) = DateVal

            pasterow = pasterow + 1
        End If
    Next i
    Exit Sub

ElseIf ws2.Range("H4").Value = "" Then            
    For i = 3 To endrow
        If ws1.Cells(i, 3).Value <> "TOT" Then
            If ws1.Cells(i, 1).Value = CountryVal Then

                With ws1
                    Set Rng = .Range(.Cells(i, 1), .Cells(i, 5))
                End With

                Rng.Copy
                ws2.Cells(pasterow, 1).PasteSpecial
                ws2.Cells(pasterow, 6) = DateVal

                pasterow = pasterow + 1 
            End If
        End If
    Next i
    Exit Sub
Else
    For i = 3 To endrow
        If ws1.Cells(i, 3).Value <> "TOT" Then
            If ws1.Cells(i, 1).Value = CountryVal Then
                If ws1.Cells(i, 2).Value = CurrencyVal Then

                    With ws1
                        Set Rng = .Range(.Cells(i, 1), .Cells(i, 5))
                    End With

                    Rng.Copy
                    ws2.Cells(pasterow, 1).PasteSpecial
                    ws2.Cells(pasterow, 6) = DateVal

                    pasterow = pasterow + 1
                End If
            End If            
        End If
    Next i
    Exit Sub

End If
End Sub

由于我对整个Excel / VBA世界都是陌生的，所以对我如何以任何方式使代码更快或更更好的任何帮助或意见都受到欢迎。

谢谢！！

亚历克斯·奥利里

好吧，经过一段时间并使用DhirendraKumar的想法，Autofilter我设法使代码工作得更快。再次感谢！！

我正在回答这个问题，以便任何可能正在寻找答案的人都可以看到此示例，并将其应用于他们的问题。

答案

我已经用下面的代码回答了我的第一个问题。使用Autofilter可以提高速度，因为它不会逐行运行，因此可以更快地工作。

我没有Select在代码中使用Activate，也不再使用，所以我猜我也不需要使用。

Sub FillUp()
Dim DateVal
Dim CountryVal
Dim CurrencyVal
Dim endrow As Long, lastrow As Long, pasterow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

'Selecting the worksheets
Set ws1 = Worksheets("Cost Evolution 2")
Set ws2 = Worksheets("Sheet1")

''''declaring date, country and currency variables''''
DateVal = ws2.Range("E3").Value
CountryVal = UCase(ws2.Range("H3").Value)
CurrencyVal = UCase(ws2.Range("H4").Value)

'declaring other useful variables
pasterow = 6
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row

'delete the range we will be working with
ws2.Range("A6:F265").Clear

'start the ifs, to see what info the user wants to get
If DateVal = "" Then
    'If the country cell is empty, we do nothing. We need at least this info
    MsgBox prompt:="You didn't choose a month!!", Title:="Error: Please Choose a Month"
    Exit Sub
ElseIf CountryVal = "" Then
    With ws1.Range("A2:E2")
        .AutoFilter Field:=3, Criteria1:="<>TOT"
    End With

    ' make sure results were returned from the filter
    If (ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        ws1.Range("A3:E" & lastrow).Copy ws2.Range("A" & CStr(pasterow))

        endrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row

        ws2.Range("F" & pasterow & ":F" & endrow).Formula = DateVal

        pasterow = endrow + 1
    End If

    ws1.AutoFilterMode = False
    MsgBox prompt:="Inserted complete month"
    Exit Sub

ElseIf CurrencyVal = "" Then
    With ws1.Range("A2:E2")
        .AutoFilter Field:=3, Criteria1:="<>TOT"
        .AutoFilter Field:=1, Criteria1:=CountryVal
    End With

    ' make sure results were returned from the filter
    If (ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        ws1.Range("A3:E" & lastrow).Copy ws2.Range("A" & CStr(pasterow))

        endrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row

        ws2.Range("F" & pasterow & ":F" & endrow).Formula = DateVal

        pasterow = endrow + 1
    End If

    ws1.AutoFilterMode = False
    MsgBox prompt:="Inserted complete month for the chosen country"
    Exit Sub
Else
    With ws1.Range("A2:E2")
        .AutoFilter Field:=1, Criteria1:=CountryVal
        .AutoFilter Field:=2, Criteria1:=CurrencyVal
        .AutoFilter Field:=3, Criteria1:="<>TOT"
    End With

    ' make sure results were returned from the filter
    If (ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        ws1.Range("A3:E" & lastrow).Copy ws2.Range("A" & CStr(pasterow))

        endrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row

        ws2.Range("F" & pasterow & ":F" & endrow).Formula = DateVal

        pasterow = endrow + 1
    End If

    ws1.AutoFilterMode = False
    MsgBox prompt:="Inserted complete month for the chosen country and currency"
    Exit Sub

End If
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。