Il ciclo "intelligente" FOR EACH nelle macro Excel

[@macrobraglia]

Seguimi anche sul Blog 👇
marcobraglia.it/blog/ciclo-intelligente-for-each-nelle-macro-vba-excel

[@gianlucascorrano2283]

video con comunicazione chiara è intuitiva.

[@robertolandi7297]

Video semplici, intuitivi e ben spiegati. Grazie!

[@macrobraglia]

Grazie Roberto!

[@massimoneri5200]

Molto simpatico ed interessante.

[@nicksan7263]

Grandeeeeee

[@ivanoambrosifilms1993]

Utile! ps: come fai la freccia a video per indicare?? ;-)

[@macrobraglia]

Epic Pen!

[@claudiabellea7319]

ciao ho scritto questa macro
For i = 3 To 122
If Cells(i, 3) "" Then
Cells(i, 4) = Range("A4")
Else
Cells(i, 4) = ""
End If
Next i
che funziona regolarmente, per il passaggio successivo ho scritto questo:
For i = Range("D65000").End(xlUp).Offset(1, 0).Select To 122
If Cells(i, 3) "" Then
Cells(i, 4) = Range("A16")
Else
Cells(i, 4) = ""
End If
Next i
ma mi va in debug a questo punto (If Cells(i, 3) "" Then
)
e non riesco a capire quale sia il problema
grazie

[@macrobraglia]

Ciao, credo che il problema sia questo:
For i = Range("D65000").End(xlUp).Offset(1, 0).Select
questo comando non restituisce un numero di riga come ti serve ma seleziona una riga. Prova a sosituire il finale .select con .row
For i = Range("D65000").End(xlUp).Offset(1, 0).Row

[@claudiabellea7319]

@@macrobraglia grazie mille Marco, adesso funziona alla perfezione, sei sempre gentilissimo

[@macrobraglia]

@@claudiabellea7319 Perfetto!

[@claudiabellea7319]

Ciao ho scritto questa macro:
Application.ScreenUpdating = False
Dim foglio As String
Sheets("Calcoli").Select
Dim foglio As String
Sheets("Calcoli").Select
If Range("A3") = 0 Then
Exit Sub
ElseIf Range("A3") "" Then
foglio = Range("A3").Value
Sheets(foglio).Activate
Range("N59:W61").Select
Selection.Copy
Sheets("Calcoli").Select
Range("AZ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Dim ur As Long
Dim rng As Range
Dim cel As Range
Set rng = Range("AZ3:BI5")
For Each cel In rng
ur = Cells(Rows.Count, 115).End(xlUp).Row
If cel.Value "" Then
cel.Copy Destination:=Range("ah" & ur + 1)
End If
Next cel
For i = 3 To 122
If Cells(i, 115) "" Then
Cells(i, 116) = Range("A4")
Else
Cells(i, 35) = ""
End If
Next i
se però dopo aver fatto la parte qui sopra non ha trovato valori da copiare, quando fa questa seconda parte, mi da errore: ✔
If Range("A6") = 0 Then
Call Calcoli162818
ElseIf Range("A6") "" Then
foglio = Range("A6").Value
Sheets(foglio).Activate
Range("N59:W61").Select
Selection.Copy
Sheets("Calcoli").Select
Range("AZ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Set rng = Range("AZ3:BI5")
For Each cel In rng
ur = Cells(Rows.Count, 115).End(xlUp).Row
If cel.Value "" Then
cel.Copy Destination:=Range("ah " & ur + 1)
- ✔ LA MACRO DA IN DEBUG IN QUESTO PUNTO E MI DA (ERRORE DI RUNTIME 1004 METODO RANGE DELL'OGGETTO GLOBAL NON RIUSCITO)
End If
Next cel
For i = Range("AI65000").End(xlUp).Offset(1, 0).Row To 122
If Cells(i, 115) "" Then
Cells(i, 116) = Range("A7")
Else
Cells(i, 116) = ""
End If
Next i
Application.ScreenUpdating = False
Dim foglio As String
Sheets("Calcoli").Select
If Range("A3") = 0 Then
Exit Sub
ElseIf Range("A3") "" Then
foglio = Range("A3").Value
Sheets(foglio).Activate
Range("N59:W61").Select
Selection.Copy
Sheets("Calcoli").Select
Range("AZ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Dim ur As Long
Dim rng As Range
Dim cel As Range
Set rng = Range("AZ3:BI5")
For Each cel In rng
ur = Cells(Rows.Count, 115).End(xlUp).Row
If cel.Value "" Then
cel.Copy Destination:=Range("ah" & ur + 1)
End If
Next cel
For i = 3 To 122
If Cells(i, 115) "" Then
Cells(i, 116) = Range("A4")
Else
Cells(i, 35) = ""
End If
Next i
If Range("A6") = 0 Then
Call Calcoli162818
ElseIf Range("A6") "" Then
foglio = Range("A6").Value
Sheets(foglio).Activate
Range("N59:W61").Select
Selection.Copy
Sheets("Calcoli").Select
Range("AZ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Set rng = Range("AZ3:BI5")
For Each cel In rng
ur = Cells(Rows.Count, 115).End(xlUp).Row
If cel.Value "" Then
cel.Copy Destination:=Range("ah " & ur + 1)
End If
Next cel
For i = Range("AI65000").End(xlUp).Offset(1, 0).Row To 122
If Cells(i, 115) "" Then
Cells(i, 116) = Range("A7")
Else
Cells(i, 116) = ""
End If
Next i
Grazie mille
ciao
Claudia

[@macrobraglia]

Ciao, è probabile che vada in Debug perchè la variabile UR non è definita.
Nelle righe precedente prova ad aggiungere un msgbox dopo la tua riga in cui definisci ur per vedere che valore ha:
ur = Cells(Rows.Count, 115).End(xlUp).Row
msgbox ur
in questo modo ti dovrebbe comparire un pop up con il valore.
Una volta capito che valore ha ur in quel momento, puoi "intrappolare" questa condizione e uscire dalla macro per evitare l'errore

[@claudiabellea7319]

@@macrobraglia mi è uscito il pop up con il valore "2" ma non riesco a capire come sistemare la macro perché funzioni. Grazie

[@macrobraglia]

@@claudiabellea7319 Ho notato adesso che hai uno spazio nella definizione del range "ah " & ur. Diventa AH 3 e non piace....prova a togliere lo spazio "ah" & ur

[@claudiabellea7319]

@@macrobraglia grazie mille!!!!! adesso funziona tutto alla perfezione

[@macrobraglia]

@@claudiabellea7319 super!

[@claudiabellea7319]

Ciao Marco, ho scritto questa macro:
If A6 = "" Then Range("F6:L6").Interior.Color = xlNone
If ("A6") = 1 Then Range("F6:L6").Interior.Color = 255
If ("B6") = 1 Then Range("F6:L6").Interior.Color = 15773696
If ("C6") = 1 Then Range("F6:L6").Interior.Color = 15773696
If ("D6") = 1 Then Range("F6:L6").Interior.Color = 15773696
avrei bisogno però che si ripetesse dalla riga 6 alla riga 1000. Ho provato ad applicare il ciclo For ma non funziona, sicuramente sto sbagliando qualcosa. Mi potresti aiutare? grazie mille

[@macrobraglia]

Ti basta usare un indice di riga i:
For i=6 to 1000
If cells(i, 1) = "" then Range(cells(i,6), cells(i,10)).interior.color = xlNone
..... Ripeti per tutti i casi...
Next i

[@claudiabellea7319]

@@macrobraglia grazie mille gentilissimo come sempre