VBA мой макрос дублирует результат оператора if, если изменился - PullRequest
Новая
       34

VBA мой макрос дублирует результат оператора if, если изменился

0 голосов
/ 07 марта 2019

Что он делает, это просто проверяет операторы if, а если нет, то в этом случае "Ни", затем напишите предложение в O.

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

Так и должно быть, когда все заполнено и я меняю ячейку. Как и должно быть

Так происходит после смены ячейки, как я делал в L6. После того, как я изменил значение в L6 Он дублирует в ячейке O6, а в ячейке O4 он тоже дублирует.

Код: 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Range("D2:L102"), Range(Target.Address)) Is Nothing Then
        Call SampleMacro
    End If

End Sub

Sub SampleMacro()

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

   For i = startRow To lastRow

    ' If there's Nee/Matig in D column, then append next sentence
    If Sheet3.Range("D" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = "? Er wordt in de cookie policy niet uitgelegd wat cookies zijn."
    ElseIf Sheet3.Range("D" & i).Value = "Matig" Then
        Sheet3.Range("O" & i).Value = "? Er wordt in de cookie policy matig uitgelegd wat cookies zijn."
    End If

    ' If there's Nee/Matig in E column, then append next sentence with new line (Chr(10))
    If Sheet3.Range("E" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Waarom ze nuttig zijn is hier niet omschreven."
    ElseIf Sheet3.Range("E" & i).Value = "Matig" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Waarom ze nuttig zijn is hier matig omschreven."
    End If

    ' If there's Nee/Matig in F column, then append next sentence with new line (Chr(10))
    If Sheet3.Range("F" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? De soorten cookies die worden gebruikt zijn niet uitgelegd."
    ElseIf Sheet3.Range("F" & i).Value = "Matig" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? De soorten cookies die worden gebruikt zijn matig uitgelegd."
    End If

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

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

    'If there's Nee/Matig in I column, then append next sentence with new line (Chr(10))
    If Sheet3.Range("I" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Hoe we de cookie-instellingen kunnen wijzigen is nergens neergeschreven."
    ElseIf Sheet3.Range("I" & i).Value = "Matig" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Hoe we de cookie-instellingen kunnen wijzigen is matig neergeschreven."
    End If

     'If there's Nee/Matig in J column, then append next sentence with new line (Chr(10))
    If Sheet3.Range("J" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Hoe de cookiegegevens gewist kunnen worden is nergens te vinden."
    ElseIf Sheet3.Range("J" & i).Value = "Matig" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Hoe de cookiegegevens gewist kunnen worden is matig te vinden."
    End If

     'If there's Nee/Matig in K column, then append next sentence with new line (Chr(10))
    If Sheet3.Range("K" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Er wordt niet gesproken over derde partijen."
    ElseIf Sheet3.Range("K" & i).Value = "Matig" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Er wordt matig gesproken over derde partijen."
    End If

    'If there's Nee/Matig in L column, then append next sentence with new line (Chr(10))
    If Sheet3.Range("L" & i).Value = "Nee" Then
        Sheet3.Range("O" & i).Value = Sheet3.Range("O" & i).Value & Chr(10) & "? Tenslotte is de verwerkingsverantwoordelijke niet aanwezig op het cookiebeleid."
    End If

    Next

End Sub

Ответы [ 2 ]

1 голос
/ 07 марта 2019

Ваш код должен выглядеть так: 

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    If Not Application.Intersect(Range("D2:L102"), Range(Target.Address)) Is Nothing Then
        Call SampleMacro
    End If
    Application.EnableEvents = True

End Sub

Вы делаете это, чтобы SampleMacro не вызывал снова событие Worksheet_Change.

Отредактировано:

Чтобы избежать повторного заполнения уже заполненных ячеек, вам нужно нацелиться на строку, которую вы изменили следующим образом: 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

   Application.EnableEvents = False
    If Not Application.Intersect(Range("D2:L102"), Range(Target.Address)) Is Nothing Then
        Call SampleMacro(Target.Row)
    End If
    Application.EnableEvents = True

End Sub

Это должен быть код на объекте листа. Как видите, я включаю переменную Target.Row в SampleMacro, поэтому код проверяет только строку, в которой была изменена ваша ячейка. 

Option Explicit
Sub SampleMacro(i As Long)

    ' Get the last row
    Dim Sheet3 As Worksheet
    Dim j As Integer
    Set Sheet3 = ThisWorkbook.Sheets("BBDD") 'whatever is called your sheet

    With Sheet3
        For j = 4 To 12 'For columns D to J
            Select Case .Cells(i, j)
                Case "Nee" 'If the cells says "Nee"
                    Select Case j 'depending on the column number
                        Case 4 'Column D
                            .Cells(i, "O") = "? Er wordt in de cookie policy niet uitgelegd wat cookies zijn."
                        Case 5 'Column E

                        Case 6 'Column F

                        Case 7 'Column G

                        Case 8 'Column H

                        Case 9 'Column I

                        Case 10 'Column J

                        Case 11 'Column K

                        Case 12 'Column L

                    End Select
                Case "Matig" 'If the cells says "Matig"
                    Select Case j 'depending on the column number
                        Case 4 'Column D
                            .Cells(i, "O") = "? Er wordt in de cookie policy matig uitgelegd wat cookies zijn."
                        Case 5 'Column E

                        Case 6 'Column F

                        Case 7 'Column G

                        Case 8 'Column H

                        Case 9 'Column I

                        Case 10 'Column J

                        Case 11 'Column K

                        Case 12 'Column L

                    End Select
        Next j
    End With    

End Sub

Я не закончил весь код, но я надеюсь, что вы понимаете, как это закончить. Select Case более читабелен в этом случае, я перебираю столбцы с D по L, используя переменную j, и один случай выбора проверяет, что находится внутри ячейки "Nee" или "Matig", и в зависимости от того, какой из них затем другой Select Case, который проверяет номер столбца. При этом ваш код будет выглядеть чище и легче для чтения.

0 голосов
/ 07 марта 2019
...