Moderatori: Anthony47, Flash30005
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valore As Double, Campo As Range, Confronto As Boolean, VeroFalso As Range
Dim Cella As Range, Vuote As Boolean, Inserimento As Range
If Not Intersect(Target, Range("A1")) Is Nothing Then
Set Campo = Range("A3:A1000")
Valore = Range("A2").Value
Confronto = Application.WorksheetFunction.CountIf(Campo, Target) > 0
Vuote = Application.WorksheetFunction.CountBlank(Campo) > 0
If Confronto = False Then
If Vuote = False Then
MsgBox "Non ci sono celle vuote nel range " & Campo.Address & " !!!", vbCritical + vbOKOnly, "ERRORE"
GoTo fine
Else
Set Inserimento = Campo.Find("", , xlValues)
Inserimento.Value = Range("A1").Value
Set Inserimento = Nothing
End If
End If
Set VeroFalso = Range("B2:L2")
Application.EnableEvents = False
For Each Cella In VeroFalso
If Cella.Offset(-1, 0).Value = True Then
Cella.Value = Valore
End If
Next
Application.EnableEvents = True
fine:
Set Campo = Nothing
Set VeroFalso = Nothing
End If
End Sub
Marco75CT ha scritto:Esempio:
Se in A1 c'è il valore Val3 ed in A2 il valore 135,00 in corrispondenza la cella che interseca riga A3 e colonna VERO sarà popolata con il valore 135,00.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valore As Double, Campo As Range, Confronto As Boolean, VeroFalso As Range
Dim Cella As Range, Vuote As Boolean, Inserimento As Range, Riga As Long
If Not Intersect(Target, Range("A1")) Is Nothing Then
Set Campo = Range("A3:A1000")
Valore = Range("A2").Value
Confronto = Application.WorksheetFunction.CountIf(Campo, Target) > 0
Vuote = Application.WorksheetFunction.CountBlank(Campo) > 0
If Confronto = False Then
If Vuote = False Then
MsgBox "Non ci sono celle vuote nel range " & Campo.Address & " !!!", vbCritical + vbOKOnly, "ERRORE"
GoTo fine
Else
Set Inserimento = Campo.Find("", , xlValues)
Inserimento.Value = Range("A1").Value
Riga = Inserimento.Row
Set Inserimento = Nothing
End If
Else
Set Inserimento = Campo.Find(Target, , xlValues)
Riga = Inserimento.Row
Set Inserimento = Nothing
End If
Set VeroFalso = Range("B" & Riga & ":L" & Riga)
VeroFalso.ClearContents
Application.EnableEvents = False
For Each Cella In VeroFalso
If Cells(1, Cella.Column).Value = True Then
Cella.Value = Valore
End If
Next
Application.EnableEvents = True
fine:
Set Campo = Nothing
Set VeroFalso = Nothing
End If
End Sub
Torna a Applicazioni Office Windows
Inserimento parziale valore cella in MessageBox Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 6 |
Aggiornare cella con somma quando aggiungo nuova colonna Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 1 |
inserisci valore in celle a seguito di condizione Autore: ucame |
Forum: Applicazioni Office Windows Risposte: 10 |
Visitano il forum: Nessuno e 14 ospiti