Question

我在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世界都是陌生的。

谢谢！

Answer 1

好吧，经过一段时间并使用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

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

1 个答案: