Verificando uma célula de destino dependendo do valor em outra célula na mesma linha

0

Estou tentando validar uma entrada de célula com duas funções de expressão regular.

A ideia é que se o valor na coluna C for "L", use uma das duas funções. O problema é que as caixas de mensagem são impressas para cada correspondência de "L" ou "T" e eu quero uma caixa de mensagem para cada linha marcada por vez.

Aqui está o meu código:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

Set rng1 = Range([c3], Cells(Rows.Count, "C").End(xlUp))

'Variable for splitting the cell string value

Dim a As Variant
Dim cell As Range
Dim msg As String
    msg = ""

    arr = Split(Target, " ")

For Each a In arr

If Target.Column = 11 And (Target.row > 2 And Target.row <= 308) Then

For Each cell In rng1

If (cell.value = "L") And (Target.row = 3) Then

    If IsItGood(a) Then
    'Gets the current cell + checks every splitted string whether it is a valid string in the list's function
    MsgBox (" In cell" + Target.row) & vbCrLf & a & vbCrLf + "is ok"

    'If the above function is not true, displays another msgbox
    Else
        MsgBox (" In cell" + Target.Address(0, 0)) & vbCrLf & a & vbCrLf + "is invalid value"

        'Because we won't allow wrong values , this method undoes only the last action taken by the user before running the macro
        Application.Undo
    End If

 End If

 'End of for loop

  Next cell
   End If

    Next a

   For Each a In arr

    If Target.Column = 11 And (Target.row > 2 And Target.row <= 308) Then
            For Each cell In rng1

 If (cell.value = "T") And (Target.row = 3) Then

   If IsItGood2(a) Then

       MsgBox (" In cell" + Target.Address(0, 0)) & vbCrLf & a & vbCrLf + "is ok"

    Else
        MsgBox (" In cell" + Target.Address(0, 0)) & vbCrLf & a & vbCrLf + "is invalid value"

        Application.Undo
    End If

  End If

    Next cell
  End If
    Next a

Application.EnableEvents = True
End Sub

Aqui está a planilha:

    
por user3701825 20.06.2018 / 10:00

0 respostas