Проблема с диапазоном VBA: запуск макроса занимает слишком много времени - PullRequest
0 голосов
/ 07 мая 2019

Немного быстрой информации:
Мой код проверяет, когда значение изменяется, а затем выполняет код, который вы найдете ниже.Строки результата помещаются в столбец R.

Проблема заключается в следующем:
Когда изменяется одно значение, код запускается и снова выполняет все строки, что требует слишком много вычислительной работы ивремя.

Что я хочу:
Я хочу, только когда значение изменяется в строке, и будет заменена только та строка, в которой значение было изменено, значение в столбце Rили заполнено.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Range("C2:P150"), Range(Target.Address)) Is Nothing Then
        'If you add (an)other row(s) edit the range above
        Call DeleteR2R150
        'If you add (an)other row(s) edit the range above
        Call SampleMacro1
    End If

End Sub

Sub DeleteR2R150()
    Range("R2:R150").Select
    'If you add (an)other row(s) edit the range above
    Selection.ClearContents
End Sub


Sub SampleMacro1()

    ' Get the last row
    Dim startRow As Long, lastRow As Long
    startRow = 2
    lastRow = Sheet4.Cells(Sheet4.Rows.Count, 1).End(xlUp).Row

   For i = startRow To lastRow

    ' If there's Nee/Matig in C column, then append next sentence
    If Sheet4.Range("C" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = "? De privacy policy is niet transparant."
    ElseIf Sheet4.Range("C" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = "? De privacy policy is gedeeltelijk transparant."
    End If

    ' If there's Nee/Matig in D column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("D" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De inhoud is grotendeels onbegrijpelijk wegens juridisch opgebouwde teksten."
    ElseIf Sheet4.Range("D" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De inhoud is grotendeels begrijpelijk, maar sommige woorden hebben duidelijkere synoniemen."
    End If

    ' If there's Nee/Matig in E column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("E" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De privacy policy is hier niet aanwezig."
    ElseIf Sheet4.Range("E" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De privacy policy was te vinden onder een andere naam."
    End If

    ' If there's Nee/Matig in F column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("F" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Deze policy is allesbehalve beknopt geschreven."
    ElseIf Sheet4.Range("F" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Deze policy is deels beknopt geschreven."
    End If

    'If there's Nee/Matig in G column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("G" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De verwerkingsverantwoordelijke is niet aanwezig op de privacy policy."
    ElseIf Sheet4.Range("G" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Een deel van de gegevens van de verwerkingsverantwoordelijke is niet aanwezig op de privacy policy."
    End If

    'If there's Nee/Matig in H column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("H" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Welke gegevens ze verzamelen is niet aanwezig."
    ElseIf Sheet4.Range("H" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Welke gegevens ze verzamelen is matig aanwezig."
    End If

     'If there's Nee/Matig in I column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("I" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De manier waarop ze gegevens verzamelen is niet omschreven."
    ElseIf Sheet4.Range("I" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De manier waarop ze gegevens verzamelen is matig omschreven."
    End If

     'If there's Nee/Matig in J column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("J" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De uiteindelijke doeleinden voor de gegevens zijn nergens terug te vinden."
    ElseIf Sheet4.Range("J" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De uiteindelijke doeleinden voor de gegevens zijn matig terug te vinden."
    End If

    'If there's Nee/Matig in K column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("K" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Met wie de gegevens gedeeld worden staat niet in de privacy policy."
     ElseIf Sheet4.Range("K" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Met wie de gegevens gedeeld worden staat matig in de privacy policy."
    End If


    'If there's Nee/Matig in L column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("L" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Nergens wordt er gesproken over hoe ze gegevens beschermen."
     ElseIf Sheet4.Range("L" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Er wordt matig gesproken over hoe ze gegevens beschermen."
    End If

    'If there's Nee/Matig in M column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("M" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Over de bewaartermijn van de gegevens wordt er niet gesproken."
     ElseIf Sheet4.Range("M" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? Over de bewaartermijn van de gegevens wordt er matig gesproken."
    End If

    'If there's Nee/Matig in N column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("N" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De verschillende rechten die personen hebben is hier niet omschreven."
     ElseIf Sheet4.Range("N" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De verschillende rechten die personen hebben is hier matig omschreven."
    End If

    'If there's Nee/Matig in O column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("O" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De gegevens worden wel/niet verwerkt buiten de EER maar dit staat niet in de privacy policy."
     ElseIf Sheet4.Range("O" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De gegevens worden wel/niet verwerkt buiten de EER maar dit staat matig in de privacy policy."
    End If

    'If there's Nee/Matig in P column, then append next sentence with new line (Chr(10))
    If Sheet4.Range("P" & i).Value = "Nee" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De uitleg over de geautomatiseerd besluitvorming en het al dan niet gebruik ervan staat niet in de privacy policy."
     ElseIf Sheet4.Range("P" & i).Value = "Matig" Then
        Sheet4.Range("R" & i).Value = Sheet4.Range("R" & i).Value & Chr(10) & "? De uitleg over de geautomatiseerd besluitvorming en het al dan niet gebruik ervan staat matig in de privacy policy."
    End If


    Next

End Sub

Может ли кто-нибудь мне помочь?

Ответы [ 2 ]

0 голосов
/ 07 мая 2019

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

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Application.Intersect(Range("C2:P150"), Range(Target.Address)) Is Nothing Then
        Call DeleteR2R150
        Call SampleMacro1
    End If
    Application.EnableEvents = True
End Sub
0 голосов
/ 07 мая 2019

Вы можете попробовать:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Range("C2:P150"), Range(Target.Address)) Is Nothing And Target.Count = 1 Then 'It s better to use Target.Count = 1 in oder to trigget the code only if one cell is change to avoid errors
        'If you add (an)other row(s) edit the range above
        Call DeleteR2R150
        'If you add (an)other row(s) edit the range above
        Call SampleMacro1
    End If

End Sub

Sub DeleteR2R150()

    Range("R2:R150").ClearContents  'It s a better idea to specify worksheet.
    'If you add (an)other row(s) edit the range above

End Sub


Sub SampleMacro1()

    ' Get the last row
    Dim startRow As Long, lastRow As Long, i As Long
    startRow = 2

    With thisworkbok.Worksheets("Sheet4") 'Use with statement to avoid reputation

        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        Application.EnableEvents = False 'Disable event to avoid code trigger each time you change something

        For i = startRow To lastRow

            ' If there's Nee/Matig in C column, then append next sentence
            If .Range("C" & i).Value = "Nee" Then
                .Range("R" & i).Value = "? De privacy policy is niet transparant."
            ElseIf .Range("C" & i).Value = "Matig" Then
                .Range("R" & i).Value = "? De privacy policy is gedeeltelijk transparant."
            End If

            ' If there's Nee/Matig in D column, then append next sentence with new line (Chr(10))
            If .Range("D" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De inhoud is grotendeels onbegrijpelijk wegens juridisch opgebouwde teksten."
            ElseIf .Range("D" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De inhoud is grotendeels begrijpelijk, maar sommige woorden hebben duidelijkere synoniemen."
            End If

            ' If there's Nee/Matig in E column, then append next sentence with new line (Chr(10))
            If .Range("E" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De privacy policy is hier niet aanwezig."
            ElseIf .Range("E" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De privacy policy was te vinden onder een andere naam."
            End If

            ' If there's Nee/Matig in F column, then append next sentence with new line (Chr(10))
            If .Range("F" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Deze policy is allesbehalve beknopt geschreven."
            ElseIf .Range("F" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Deze policy is deels beknopt geschreven."
            End If

            'If there's Nee/Matig in G column, then append next sentence with new line (Chr(10))
            If .Range("G" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De verwerkingsverantwoordelijke is niet aanwezig op de privacy policy."
            ElseIf .Range("G" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Een deel van de gegevens van de verwerkingsverantwoordelijke is niet aanwezig op de privacy policy."
            End If

            'If there's Nee/Matig in H column, then append next sentence with new line (Chr(10))
            If .Range("H" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Welke gegevens ze verzamelen is niet aanwezig."
            ElseIf .Range("H" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Welke gegevens ze verzamelen is matig aanwezig."
            End If

             'If there's Nee/Matig in I column, then append next sentence with new line (Chr(10))
            If .Range("I" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De manier waarop ze gegevens verzamelen is niet omschreven."
            ElseIf .Range("I" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De manier waarop ze gegevens verzamelen is matig omschreven."
            End If

             'If there's Nee/Matig in J column, then append next sentence with new line (Chr(10))
            If .Range("J" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De uiteindelijke doeleinden voor de gegevens zijn nergens terug te vinden."
            ElseIf .Range("J" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De uiteindelijke doeleinden voor de gegevens zijn matig terug te vinden."
            End If

            'If there's Nee/Matig in K column, then append next sentence with new line (Chr(10))
            If .Range("K" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Met wie de gegevens gedeeld worden staat niet in de privacy policy."
             ElseIf .Range("K" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Met wie de gegevens gedeeld worden staat matig in de privacy policy."
            End If


            'If there's Nee/Matig in L column, then append next sentence with new line (Chr(10))
            If .Range("L" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Nergens wordt er gesproken over hoe ze gegevens beschermen."
             ElseIf .Range("L" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Er wordt matig gesproken over hoe ze gegevens beschermen."
            End If

            'If there's Nee/Matig in M column, then append next sentence with new line (Chr(10))
            If .Range("M" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Over de bewaartermijn van de gegevens wordt er niet gesproken."
             ElseIf .Range("M" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? Over de bewaartermijn van de gegevens wordt er matig gesproken."
            End If

            'If there's Nee/Matig in N column, then append next sentence with new line (Chr(10))
            If .Range("N" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De verschillende rechten die personen hebben is hier niet omschreven."
             ElseIf .Range("N" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De verschillende rechten die personen hebben is hier matig omschreven."
            End If

            'If there's Nee/Matig in O column, then append next sentence with new line (Chr(10))
            If .Range("O" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De gegevens worden wel/niet verwerkt buiten de EER maar dit staat niet in de privacy policy."
             ElseIf .Range("O" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De gegevens worden wel/niet verwerkt buiten de EER maar dit staat matig in de privacy policy."
            End If

            'If there's Nee/Matig in P column, then append next sentence with new line (Chr(10))
            If .Range("P" & i).Value = "Nee" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De uitleg over de geautomatiseerd besluitvorming en het al dan niet gebruik ervan staat niet in de privacy policy."
             ElseIf .Range("P" & i).Value = "Matig" Then
                .Range("R" & i).Value = .Range("R" & i).Value & Chr(10) & "? De uitleg over de geautomatiseerd besluitvorming en het al dan niet gebruik ervan staat matig in de privacy policy."
            End If

        Next i

        Application.EnableEvents = True 'Eanble events

    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...