mi sono bloccato nella costruzione di una macro che rilevi in colonna F se sono contenute alcune parole (SERBIA, BOSNIA, ecc) e nel caso siano presenti venga riportato in colonna N, sulla stessa riga, la dicitura "PRECEDENZA T1".
Per fare questo ho scritto il codice in questo modo:
- Codice: Seleziona tutto
If Not Intersect(Target, Range("F2:F201")) Is Nothing Then Exit Sub
If Cells(Riga, 6).Value = "SERBIA" Then
Cells(Riga, 13).Value = "PRECEDENZA T1"
End If
If Cells(Riga, 6).Value = "BOSNIA" Then
Cells(Riga, 13).Value = "PRECEDENZA T1"
End If
End If
Ma ricevo un errore in cui viene indicato l'ultimo End If come di troppo.. ma non capisco il perchè dal momento che ci sono tutte le aperture e le chiusure (dell' If).
Andando per tentativi (a casaccio
) ho provato anche così:- Codice: Seleziona tutto
If Not Intersect(Target, Range("F2:F201")) Is Nothing Then Exit Sub
If Cells(Riga, 6).Value = "SERBIA" Then
Cells(Riga, 13).Value = "PRECEDENZA T1"
Else
If Cells(Riga, 6).Value = "BOSNIA" Then
Cells(Riga, 13).Value = "PRECEDENZA T1"
End If
End If
Non ricevo errore, ma la macro non fa il suo dovere.
Che il problema sia legato al resto del codice che compone Private Sub Worksheet_Change?
Per completezza riporto di seguito tutto il codice che compone la Worksheet_Change e dove ho piazzato il pezzo di macro incriminato:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Range("B2:P201")) Is Nothing Then
Select Case Target.Column
Case Is = 2 'B..
Target.Offset(0, 1).Select '..C
Case Is = 3 'C..
Target.Offset(0, 3).Select '..F
Case Is = 6 'F..
Target.Offset(0, 2).Select '..H
Case Is = 8 'H..
Target.Offset(0, 1).Select '..I
Case Is = 9 'I..
Target.Offset(0, 7).Select '..P
Case Is = 16 'P..
Target.Offset(1, -14).Select '..B+1
End Select
End If
End If
If Target.Count = 1 Then
If Target.Column = 2 Then
Application.EnableEvents = False
Call Pusher(Target.Value, "|", Target.Row)
Application.EnableEvents = True
End If
End If
Dim cvArea As String, cvElenco As Range, myCk
Dim DizArea As Range
'
'Parametri>>>:
cvArea = "H2:H201" 'Area Convalidata
Set cvElenco = Sheets("MERCI").Range("B16:B100") 'Area con le voci di convalida
Set DizArea = Sheets("MERCI").Range("D2:E50") 'Area del Dizionario
'
'Controlla se va fatta la verifica:
If Target.Count = 1 And (Not Application.Intersect(Target, Range(cvArea)) Is Nothing) Then
myCk = Application.WorksheetFunction.CountIf(cvElenco, Target.Value) 'Controlla se l'input e' in elenco
If myCk = 0 And Target.Value <> "" Then 'Non c'è
Application.EnableEvents = False
myCk = Application.VLookup(Target.Value, DizArea, 2, False) 'Cerca.Vert nel dizionario
If IsError(myCk) Then 'Non c'è:
With cvElenco.Cells(1, 1).End(xlDown).Offset(1, 0) 'Va in fondo all'elenco...
.Value = Target.Value '...ci aggiunge quel valore
.Interior.Color = RGB(255, 200, 200) '...e lo coloora in rossastro
End With
Else 'Se trova quella voce...
Target.Value = myCk '...sostituisce l'input
End If
Application.EnableEvents = True
End If
End If
If Not Intersect(Target, Range("F2:F201")) Is Nothing Then Exit Sub
If Cells(Riga, 6).Value = "SERBIA" Then
Cells(Riga, 13).Value = "PRECEDENZA T1"
Else
If Cells(Riga, 6).Value = "BOSNIA" Then
Cells(Riga, 13).Value = "PRECEDENZA T1"
End If
End If
End Sub
