Есть ли альтернатива циклу for-if в VBA? - PullRequest
0 голосов
/ 05 ноября 2019

У меня есть две таблицы в Excel. Я написал следующий код для копирования некоторых данных из Worksheet 1 в Worksheet 2 , основываясь на некоторых значениях, которые пользователь вставляет в Worksheet 2 .

Макрос работает отлично, и делает то, что мне нужно, но после его записи я понял две вещи:

  1. Для небольшого набора требуется довольно много временизаписей (260 или около того), как это происходит по одной строке за раз.
  2. Я читал, что использование .select не является хорошей практикой, и я изменил код, чтобы не использовать его, но мне остается только подумать, смогу ли я улучшить код для работыбыстрее, если бы я его использовал.

Итак, мои основные вопросы:

  1. Как я могу улучшить скорость кода, чтобы он мог читатькопируйте строки быстрее.
  2. Было бы лучше в этом случае использовать .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.

Спасибо !!

1 Ответ

0 голосов
/ 14 ноября 2019

Ну, через некоторое время и благодаря идее DhirendraKumar использовать Autofilter Мне удалось заставить код работать намного быстрее. Еще раз спасибо !!

Я отвечаю на вопрос, чтобы любой, кто может прийти в поисках ответа, мог увидеть этот пример и, возможно, применить его к своей проблеме.

Ответы

  1. Я ответил на мой первый вопрос с кодом ниже. Скорость была улучшена с помощью Autofilter, она работает быстрее, потому что она не идет строка за строкой.

  2. Я не использовал 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
    
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...