visualizzare tutti i passaggi di una macro
Salve potete dirmi passo passo come fare per vedere tutti i passaggi di una macro posizionandomi su di essa.
E quando arriva a un ciclo che torna indietro perche deve fare svariati passaggi quale tasto premere per fargli compiere tutti i passaggi di quel ciclo ( e non saltandolo)
Allego comunque la macro in questione
voglio ridimensionare la finestra di excel e quella del codice mettendoli uno a fianco all'altra in modo che ho tutto sott'occhio.
Grazie
Option Explicit
Public sh1 As Worksheet, sh2 As Worksheet, x As Long, y As Long, z As Long, cfound As Range
Sub avvia()
Dim ws1 As Worksheet 'copia gli usciti dal foglio "stampa movimenti" al foglio "usciti"
Dim ws2 As Worksheet
Dim ultK As Long
Dim ultA As Long
Dim iRiga As Long
Application.DisplayAlerts = False
Sheets("archivio").Select
Range("A3:D2489").Select ' copia i movimenti di ieri dal foglio archivio al foglio ubic ieri
Range("A3").Activate
Selection.Copy
Sheets("ubic ieri").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = True
Set ws1 = Foglio11 'fa riferimentoal foglio "stampa movimenti" che si trova all'11esimo posto nel file che vedi ma nel progetto-vbaproject
Set ws2 = Foglio21 'fa riferimento al foglio "usciti" che si trova al 21esimo posto nel file che vedi ma nel progetto-vbaproject
ultK = IIf(ws1.Range("K3").Value = "", 3, ws1.Range("K" & Rows.Count).End(xlUp).Row)
ultA = IIf(ws2.Range("A60000").Value = "", 60000, ws2.Range("A" & Rows.Count).End(xlUp).Row + 1)
Application.EnableEvents = False
If ultK > 2 Then
For iRiga = 3 To ultK
ws2.Range("A" & ultA).Value = ws1.Range("K" & iRiga).Value & " " & ws1.Range("L" & iRiga).Value
ws2.Range("B" & ultA).Value = Date 'inserisce la data del giorno che copia il nominatico e quindi la data di uscita del detenuto
ultA = ultA + 1
Next iRiga
End If
Set ws1 = Nothing
Set ws2 = Nothing
Sheets("usciti").Select 'ordina alfabetico la colonna "A" del foglio usciti
Columns("A:B").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.DisplayAlerts = False 'questa riga insieme ad Application.DisplayAlerts = true che si trova alla fine del codice dei copia movimenti, serve a far si che i nomi vecchi vengano cancellati e sostituiti da quelli nuovi senza che esca la finestra che ti chiede sostituirli o no.
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("sr1:if2489").Select
Selection.Copy
Range("ii1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("sb1:so2489").Select
Selection.Copy
Range("sr1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("rl1:ry2489").Select
Selection.Copy
Range("sb1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("qv1:ri2489").Select
Selection.Copy
Range("rl1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("qf1:qs2489").Select
Selection.Copy
Range("qv1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("pp1:qc2489").Select
Selection.Copy
Range("qf1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("oz1:pm2489").Select
Selection.Copy
Range("pp1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("oj1:ow2489").Select
Selection.Copy
Range("oz1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("nt1:og2489").Select
Selection.Copy
Range("oj1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("nd1:nq2489").Select
Selection.Copy
Range("nt1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("mn1:na2489").Select
Selection.Copy
Range("nd1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("lx1:mk2489").Select
Selection.Copy
Range("mn1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("lh1:lu2489").Select
Selection.Copy
Range("lx1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("kr1:le2489").Select
Selection.Copy
Range("lh1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("kc1:kp2489").Select
Selection.Copy
Range("kr1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("jn1:ka2489").Select
Selection.Copy
Range("kc1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("iy1:jl2489").Select
Selection.Copy
Range("jn1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("ii1:iv2489").Select
Selection.Copy
Range("iy1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
Range("hs1:if2489").Select
Selection.Copy
Range("ii1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 14 giorni prima per lasciarti una copia in caso servisse
Range("hc1:hp2489").Select
Selection.Copy
Range("hs1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 13 giorni prima per lasciarti una copia in caso servisse
Range("gm1:gz2489").Select
Selection.Copy
Range("hc1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 12 giorni prima per lasciarti una copia in caso servisse
Range("fw1:gj2489").Select
Selection.Copy
Range("gm1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 11 giorni prima per lasciarti una copia in caso servisse
Range("fg1:ft2489").Select
Selection.Copy
Range("fw1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 10 giorni prima per lasciarti una copia in caso servisse
Range("eq1:fd2489").Select
Selection.Copy
Range("fg1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 9 giorni prima per lasciarti una copia in caso servisse
Range("ea1:en2489").Select
Selection.Copy
Range("eq1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 8 giorni prima per lasciarti una copia in caso servisse
Range("dk1:dx2489").Select
Selection.Copy
Range("ea1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 7 giorni prima per lasciarti una copia in caso servisse
Range("cu1:dh2489").Select
Selection.Copy
Range("dk1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 6 giorni prima per lasciarti una copia in caso servisse
Range("ce1:cr2489").Select
Selection.Copy
Range("cu1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 5 giorni prima per lasciarti una copia in caso servisse
Range("bo1:cb2489").Select
Selection.Copy
Range("ce1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 4 giorni prima per lasciarti una copia in caso servisse
Range("ay1:bl2489").Select
Selection.Copy
Range("bo1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 3 giorni prima per lasciarti una copia in caso servisse
Range("ai1:av2489").Select
Selection.Copy
Range("ay1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti di 2 giorni prima per lasciarti una copia in caso servisse
Range("s1:af2489").Select
Selection.Copy
Range("ai1").Select
ActiveSheet.Paste
Sheets("stampa movimenti").Select 'copia i movimenti del giorno prima per lasciarti una copia in caso servisse
Range("A1:N2489").Select
Selection.Copy
Range("S1").Select
ActiveSheet.Paste
Application.DisplayAlerts = True 'questa riga insieme ad Application.DisplayAlerts = False che si trova all'inizio del codice dei copia movimenti, serve a far si che i nomi vecchi vengano cancellati e sostituiti da quelli nuovi senza che esca la finestra che ti chiede sostituirli o no.
Sheets("presenti").Select 'aggiorna i dati del foglio "presenti" con il file gedet che si trova sul gedet
Dim iki As Long
For iki = 1 To 238 Step 7 'iki è il un riferimento che si da alla colonna quindi si inizia ad aggiornare dalla colonna 1perch' iki=1 e si arriva alla 129 saltando di 7 colonne step=7
Cells(2, iki).Select 'iniziando dalla riga 2 colonna 1
Selection.QueryTable.Refresh BackgroundQuery:=False
Next iki
'Sheets("usciti").Select ' aggiorna il foglio usciti
' Range("a2").Select
' Selection.QueryTable.Refresh BackgroundQuery:=False
' Range("f2").Select
' Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("I").Select ' seleziona A5-B5-C5 di tutte le sezioni e trascina giu per eliminare errori
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("II").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("III").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("IV").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("V").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("VI").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("VII").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("VIII").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
Range("A5:C92").Select
Sheets("IX").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
Range("A5:C89").Select
Sheets("X").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C90"), Type:=xlFillDefault
Range("A5:C90").Select
Sheets("XI").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
Range("A5:C89").Select
Sheets("XII").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
Range("A5:C89").Select
Sheets("XIII").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
Range("A5:C89").Select
Sheets("C.CL.").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C50"), Type:=xlFillDefault
Range("A5:C50").Select
Range("A51:C51").Select
Selection.AutoFill Destination:=Range("A51:C70"), Type:=xlFillDefault
Range("A51:C70").Select
Range("A71:C71").Select
Selection.AutoFill Destination:=Range("A71:C120"), Type:=xlFillDefault
Range("A71:C120").Select
Range("A121:C121").Select
Selection.AutoFill Destination:=Range("A121:C140"), Type:=xlFillDefault
Range("A121:C140").Select
Range("A141:C141").Select
Selection.AutoFill Destination:=Range("A141:C150"), Type:=xlFillDefault
Range("A141:C150").Select
Range("A151:C151").Select
Selection.AutoFill Destination:=Range("A151:C170"), Type:=xlFillDefault
Range("A151:C170").Select
Range("A171:C171").Select
Selection.AutoFill Destination:=Range("A171:C210"), Type:=xlFillDefault
Range("A171:C210").Select
Range("A211:C211").Select
Selection.AutoFill Destination:=Range("A211:C240"), Type:=xlFillDefault
Range("A211:C240").Select
Range("A345:C345").Select
Selection.AutoFill Destination:=Range("A345:C466"), Type:=xlFillDefault
Range("A345:C466").Select
Range("A347:C347").Select
Selection.AutoFill Destination:=Range("A347:C497"), Type:=xlFillDefault
Range("A347:C497").Select
Range("A498:C498").Select
Selection.AutoFill Destination:=Range("A498:C599"), Type:=xlFillDefault
Range("A498:C599").Select
Range("A600:C600").Select
Selection.AutoFill Destination:=Range("A600:C699"), Type:=xlFillDefault
Range("A600:C699").Select
Range("A700:C700").Select
Selection.AutoFill Destination:=Range("A700:C739"), Type:=xlFillDefault
Range("A700:C739").Select
Range("A740:C740").Select
Selection.AutoFill Destination:=Range("A740:C749"), Type:=xlFillDefault
Range("A740:C749").Select
Range("A750:C750").Select
Selection.AutoFill Destination:=Range("A750:C769"), Type:=xlFillDefault
Range("A750:C769").Select
Range("A770:C770").Select
Selection.AutoFill Destination:=Range("A770:C800"), Type:=xlFillDefault
Range("A770:C800").Select
Range("a801:C801").Select
Selection.AutoFill Destination:=Range("A801:C810"), Type:=xlFillDefault
Range("A801:C810").Select
Range("a811:C811").Select
Selection.AutoFill Destination:=Range("A811:C830"), Type:=xlFillDefault
Range("A811:C830").Select
Range("a831:C831").Select
Selection.AutoFill Destination:=Range("A831:C850"), Type:=xlFillDefault
Range("A831:C850").Select
Sheets("Transex").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C32"), Type:=xlFillDefault
Range("A5:C32").Select
Sheets("TR1").Select
Range("A5:C5").Select
Selection.AutoFill Destination:=Range("A5:C61"), Type:=xlFillDefault
Range("A5:C61").Select
Sheets("TR2").Select
Range("A5:D5").Select
Selection.AutoFill Destination:=Range("A5:D34"), Type:=xlFillDefault
Range("A5:D34").Select
Dim r As Long 'controlla i cambiamenti tra foglio"archivio" e tutti i fogli delle sezioni
Dim rr As Long
Dim G As Long
Dim K As Long
Dim l As Variant
Dim n As String
Dim p As Variant
Dim nn As Variant
Dim rg As Long
Dim trovato As Boolean
Dim dat(1 To 3)
Set sh1 = Worksheets("Archivio")
sh1.Activate
Application.EnableEvents = False
rg = Cells(Rows.Count, 15).End(xlUp).Row + 1
Range(Cells(3, 5), Cells(rg, 6)).ClearContents
Range(Cells(3, 15), Cells(rg, 15)).ClearContents
G = Cells(Rows.Count, 7).End(xlUp).Row + 1
Range(Cells(3, 7), Cells(G, 10)).ClearContents
K = Cells(Rows.Count, 11).End(xlUp).Row + 1
Range(Cells(3, 11), Cells(K, 14)).ClearContents
'Application.ScreenUpdating = False''non fa vedere i passaggi dei controlli sezione per sezione se togli le virgolette lo attivi'
G = 3
K = 3
For x = 1 To 18
Sheets(x).Select
rg = Cells(Rows.Count, 1).End(xlUp).Row
n = Sheets(x).Name
Set sh2 = Worksheets(n)
Select Case n
Case "I": p = 1 'assegna alla sezione il numero normale anzichè il numero romano'
Case "II": p = 2
Case "III": p = 3
Case "IV": p = 4
Case "V": p = 5
Case "VI": p = 6
Case "VII": p = 7
Case "VIII": p = 8
Case "IX": p = 9
Case "X": p = 10
Case "XI": p = 11
Case "XII": p = 12
Case "XIII": p = 13
Case "Transex": p = "D"
Case "TR1": p = "TR1"
Case "TR2": p = "TR2"
Case "FEMMINILE": p = "F"
End Select
For y = 5 To rg
If Cells(y, 2) = "" Or Cells(y, 2) = 0 Then
GoTo 10
Else
If Cells(y, 1) <> "" Then
If n = "C.CL." Then 'nel foglio centro clinico...'
Select Case y
Case 5 To 140: p = "ccl" 'le celle da 5 a 50 è reparto DEG'
'Case 51 To 70: p = "OSS."
'Case 71 To 140: p = "acc."
Case 141 To 150: p = "M"
Case 151 To 170: p = "FXG"
Case 171 To 210: p = "PER"
Case 211 To 240: p = "R.O."
Case 241 To 290: p = "nota"
Case 291 To 344: p = "ITO"
Case 345 To 497: p = "?"
Case 498 To 599: p = "GIU"
Case 600 To 699: p = "PEN"
Case 700 To 739: p = "CCC"
Case 740 To 749: p = "K"
Case 750 To 769: p = "TRF"
Case 770 To 800: p = "NIDO"
Case 801 To 810: p = "FXGF"
Case 811 To 830: p = "PF"
Case 831 To 850: p = "ROF"
End Select
End If
If IsNumeric(Cells(y, 1)) Then l = Val(Cells(y, 1)) Else l = Cells(y, 1)
End If
dat(1) = l
dat(2) = Cells(y, 2)
dat(3) = Cells(y, 3)
End If
rr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
For z = 2 To rr
If sh1.Cells(z, 1) = dat(2) And sh1.Cells(z, 2) = dat(3) Then trovato = True: r = z: Exit For
Next z
If trovato = True Then
If sh1.Cells(r, 3) = p And sh1.Cells(r, 4) = dat(1) Then
sh1.Cells(r, 15) = 1
Else
sh1.Cells(r, 5) = p
sh1.Cells(r, 6) = dat(1)
sh1.Cells(r, 15) = 1
End If
End If
If trovato = False Then
r = rr + 1
sh1.Cells(r, 1) = dat(2)
sh1.Cells(r, 2) = dat(3)
sh1.Cells(r, 3) = p
sh1.Cells(r, 4) = dat(1)
sh1.Cells(G, 7) = dat(2)
sh1.Cells(G, 8) = dat(3)
sh1.Cells(G, 9) = p
sh1.Cells(G, 10) = dat(1)
sh1.Cells(r, 15) = 0
G = G + 1
End If
trovato = False
10:
Next y
Next x
sh1.Activate
r = Cells(Rows.Count, 15).End(xlUp).Row
For x = 3 To r
If x = r Then Exit For
If Cells(x, 15) = "" Then
Cells(K, 11) = Cells(x, 1)
Cells(K, 12) = Cells(x, 2)
Cells(K, 13) = Cells(x, 3)
Cells(K, 14) = Cells(x, 4)
Range(Cells(x, 1), Cells(x, 6)).Select
Selection.Delete Shift:=xlUp
Cells(x, 15).Select
Selection.Delete Shift:=xlUp
x = x - 1
r = r - 1
K = K + 1
End If
Next x
Range("A2:F2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Key2:=Range("A3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
r = Cells(Rows.Count, 5).End(xlUp).Row
Range("A2:F" & r).Select ' ordia alfabetico i movimenti'
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G2:J2").Select 'ordina alfabetico gli entrati'
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("k2:N2").Select 'ordina alfabetico gli usciti'
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A3").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Sheets("archivio").Select
Application.DisplayAlerts = False ' copia i nominativi dal foglio archivio al fogli stampa i moviment
Sheets("archivio").Select
Range("A1:r400").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("stampa movimenti").Select
Range("A1:B1").Select
ActiveSheet.Paste
Application.DisplayAlerts = True
Range("A1:R972").Select
Application.CutCopyMode = False
Selection.Interior.ColorIndex = xlNone
'Sub sta1()
Dim rt As Long
Dim r1 As Long
Dim st As String
Dim cp As Long
Dim d As Long
Dim ind As Variant
Dim rrt As Long
Dim rrtt As Long
Dim rrttt As Long
Dim rrrt As Long
'ELIMINA GLI ENTRATI E GLI USCITI CHE VENGONO RINOMINATI PERCHE' IL NOME SBAGLIATO E FINISCE A FINE 7
Dim Gt As Range, KK As Range, cl3 As Object, cl4 As Object, _
xx As Long, yy As Long, zt As Long, xt As Long, _
yt As Long, zz As Long, xtt As Long, xttt As Long, xXtt As Long
Set Gt = Range("G3:G1500")
Set KK = Range("K3:K1500")
'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
'AMMETTENDO CHE LA RIGA 1 è OCCUPATA DALLE INTESTAZIONI DI COLONNA
'EFFETTUO UN CICLO PER TROVARE LA PRIMA CELLA OCCUPATA DELLA COLONNA G;
'IN OGNI CASO PUOI MODIFICARE IL RANGE G e K EDITANDO LE VARIABILI SOPRA (Set)
For Each cl3 In Gt
If cl3 = "" Then
cl3.Select
xt = Selection.Row
Exit For
'If cl3 <> "" Then
Else
cl3.Select
xt = Selection.Row
'xt è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA G
Exit For
End If
Next
If cl3 = "" Then
yt = Cells(1500, 7).End(xlUp).Row + 1
Else
yt = Cells(1500, 7).End(xlUp).Row
End If
'yt è IL NUMERO RIGA DELL'ULTIMA CELLA OCCUPATA DELLA COLONNA G
'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
'EFFETTUO UN CICLO PER TROVARE LA PRIMA CELLA OCCUPATA DELLA COLONNA K
For Each cl4 In KK
If cl4 = "" Then
cl4.Select
xx = Selection.Row
Exit For
'If cl4 <> "" Then
Else
cl4.Select
xx = Selection.Row
'xx è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA K
Exit For
End If
Next
If cl4 = "" Then
yy = Cells(1500, 11).End(xlUp).Row + 1
Else
yy = Cells(1500, 11).End(xlUp).Row
End If
'yy è IL NUMERO RIGA DELL'ULTIMA CELLA OCCUPATA DELLA COLONNA K
'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
'DOPPIO CICLO FOR/NEXT PER CONTROLLARE OGNI RIGA OCCUPATA DELLE
'COLONNE G-H-I-J CON OGNI RIGA OCCUPATA DELLE COLONNE K-L-M-N
For zt = xt To yt
For zz = xx To yy
If Cells(zt, 9) = Cells(zz, 13) And Cells(zt, 10) = Cells(zz, 14) _
And (Cells(zt, 7) = Cells(zz, 11) Or Cells(zt, 8) = Cells(zz, 12)) Then
Range(Cells(zt, 7), Cells(zt, 10)).ClearContents
Range(Cells(zz, 11), Cells(zz, 14)).ClearContents
End If
Next zz
Next zt
'FINE 7
Dim cl, cl2, rng, RNG2, NOME, COGNOME ' CANCELLA I CAMBIAMENTI DI CELLA DEL CCL TR1 TR2 F D IL CODICE FINISCE DOV'è SCRITTO FINE2
rt = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim Condizioni As New Collection
Condizioni.Add "F|F"
Condizioni.Add "K|K"
Condizioni.Add "K|NIDO"
Condizioni.Add "K|PEN"
Condizioni.Add "K|GIU"
Condizioni.Add "K|CCC"
Condizioni.Add "NIDO|NIDO"
Condizioni.Add "NIDO|PEN"
Condizioni.Add "NIDO|GIU"
Condizioni.Add "NIDO|K"
Condizioni.Add "NIDO|CCC"
Condizioni.Add "PEN|PEN"
Condizioni.Add "PEN|K"
Condizioni.Add "PEN|NIDO"
Condizioni.Add "PEN|GIU"
Condizioni.Add "PEN|CCC"
Condizioni.Add "GIU|GIU"
Condizioni.Add "GIU|K"
Condizioni.Add "GIU|NIDO"
Condizioni.Add "GIU|PEN"
Condizioni.Add "GIU|CCC"
Condizioni.Add "CCC|CCC"
Condizioni.Add "CCC|K"
Condizioni.Add "CCC|NIDO"
Condizioni.Add "CCC|PEN"
Condizioni.Add "CCC|GIU"
Condizioni.Add "D|D"
Condizioni.Add "TR1|TR1"
Condizioni.Add "TR2|TR2"
'Condizioni.Add "TR2|TR1"
'Condizioni.Add "TR1|TR2"
Condizioni.Add "OSS.|OSS."
Condizioni.Add "I.S.|I.S."
Condizioni.Add "EXD.|EXD."
Condizioni.Add "DEG.|DEG."
Condizioni.Add "DEG.|OSS."
Condizioni.Add "DEG.|EXD."
Condizioni.Add "DEG.|I.S."
Condizioni.Add "OSS.|EXD."
Condizioni.Add "OSS.|I.S."
Condizioni.Add "OSS.|DEG."
Condizioni.Add "EXD.|DEG."
Condizioni.Add "EXD.|OSS."
Condizioni.Add "EXD.|I.S."
Condizioni.Add "I.S.|EXD."
Condizioni.Add "I.S.|OSS."
Condizioni.Add "I.S.|DEG."
ReDim c(rt) As Integer
Dim i, j, Kt, cond
Set RNG2 = Range("C3:E" & rt)
For Each cl2 In RNG2
For Each cond In Condizioni
If cl2.Offset(0, 0) = Split(cond, "|")(0) And cl2.Offset(0, 2) = Split(cond, "|")(1) Then
i = i + 1
c(i) = cl2.Row
End If
Next
Next
Kt = i
Sheets("stampa movimenti").Select
For i = 1 To Kt
ActiveSheet.Range("A1:F1").Offset(c(i) - 1, 0).Delete
For j = i + 1 To Kt
c(j) = c(j) - 1
Next
Next 'FINE2
rrt = Range("I" & Rows.Count).End(xlUp).Row 'cancella nella colonna entrati il femminile tr1 e tr2 il codice finisce a fine 6
For xt = 3 To rrt
If Cells(xt, "I") = "F" Or Cells(xt, "I") = "FXG" Or Cells(xt, "I") = "FXGF" Or Cells(xt, "I") = "TR1" Or Cells(xt, "I") = "TR2" Or Cells(xt, "I") = "GIU" Or Cells(xt, "I") = "PEN" Or Cells(xt, "I") = "CCC" Or Cells(xt, "I") = "NIDO" Or Cells(xt, "I") = "K" Or Cells(xt, "I") = "?" Then
Range("G" & xt & ":" & "J" & xt).ClearContents
End If
Next xt 'fine 5
rrtt = Range("E" & Rows.Count).End(xlUp).Row 'cancella nella colonna movimenti i fuori per giustizia i detenuti da prendere in carico(?)i permessi e ricovero finisce a fine 6
For xtt = 3 To rrtt
If Cells(xtt, "E") = "PER" Or Cells(xtt, "E") = "FXG" Or Cells(xtt, "I") = "FXGF" Or Cells(xtt, "E") = "R.O." Or Cells(xtt, "E") = "GIU" Or Cells(xtt, "E") = "PEN" Or Cells(xtt, "E") = "CCC" Or Cells(xtt, "E") = "NIDO" Or Cells(xtt, "E") = "K" Then
Range("A" & xtt & ":" & "F" & xtt).ClearContents
End If
Next xtt
rrttt = Range("C" & Rows.Count).End(xlUp).Row
For xttt = 3 To rrttt
If Cells(xttt, "C") = "PER" Or Cells(xttt, "C") = "FXG" Or Cells(xttt, "I") = "FXGF" Or Cells(xttt, "C") = "R.O." Or Cells(xttt, "C") = "GIU" Or Cells(xttt, "C") = "PEN" Or Cells(xttt, "C") = "CCC" Or Cells(xttt, "C") = "NIDO" Or Cells(xttt, "C") = "K" Then
Range("A" & xttt & ":" & "F" & xttt).ClearContents
End If
Next xttt
'rrrt = Range("M" & Rows.Count).End(xlUp).Row 'cancella nella colonna usciti
'For xXtt = 3 To rrrt
' If Cells(xXtt, "M") = "?" Or Cells(xXtt, "M") = "F" Or Cells(xXtt, "M") = "NIDO" Or Cells(xXtt, "M") = "GIU" Or Cells(xXtt, "M") = "PEN" Or Cells(xXtt, "M") = "K" Or Cells(xXtt, "M") = "CCC" Then
' Range("K" & xXtt & ":" & "N" & xXtt).ClearContents
' End If
' Next xXtt 'fine 6
Range("A3:F" & rt).Select 'ordina alfabetico colonna movimenti
Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G3:J1700").Select 'ordina alfabetico colonna entrati
Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("K3:N1700").Select ' ordina alfabetico colonna usciti
Selection.Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G8").Select
Set sh1 = Worksheets("stampa movimenti")
sh1.Activate
Application.ScreenUpdating = False
st = Cells(2, 16)
cp = Cells(2, 17)
Cells(1, 18) = Cells(Rows.Count, 5).End(xlUp).Row
r1 = Cells(1, 18)
Cells(1, 19) = Cells(Rows.Count, 7).End(xlUp).Row
Cells(1, 20) = Cells(Rows.Count, 11).End(xlUp).Row
Cells(2, 18).Select
ActiveCell.FormulaR1C1 = "=LARGE(R[-1]C:R[-1]C[2],1)"
rt = Cells(2, 18)
Range(Cells(1, 18), Cells(2, 20)).ClearContents
If r1 < rt Then
If r1 = 2 Then
Range(Cells(r1 + 1, 1), Cells(rt, 4)).Select
Selection.Insert Shift:=xlDown
Cells(4, 5).Copy
Range(Cells(r1 + 1, 1), Cells(rt, 4)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
Range(Cells(r1 + 1, 1), Cells(rt, 6)).Select
Selection.Insert Shift:=xlDown
End If
End If
If r1 < rt Then d = rt Else d = r1
Range("A3:F" & d).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
For xt = 3 To d Step 2
Range(Cells(xt, 1), Cells(xt, 14)).Interior.ColorIndex = 45 ' colora di arancione un rigo si e uno no
Next xt
'Range("A3:N" & r).Select 'seleziona l'area di stampa'
'ind = Range("A3:N" & rt).Address
'ActiveSheet.PageSetup.PrintArea = ind
'With ActiveSheet.PageSetup
' .PrintTitleRows = "$1:$2"
' .PrintTitleColumns = ""
'End With
'With ActiveSheet.PageSetup
' .LeftHeader = " &D - &T &P/&N" 'stampa data ora e numero di pagine'
' .CenterHeader = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & _
' "&""Arial""&12U F F I C I O P O S T A&""Arial,Normale""&10" & Chr(10) & _
'"&""Arial""&12" 'intestazione pagina'
' .LeftMargin = Application.InchesToPoints(0.1) 'margine sinistro della stampa'
' .RightMargin = Application.InchesToPoints(0.1) 'margine destro'
' .TopMargin = Application.InchesToPoints(1.6) 'margine alto'
' .BottomMargin = Application.InchesToPoints(0.25) 'adatta lo scritto alla pagina della stampa'
' .HeaderMargin = Application.InchesToPoints(0.1) 'abbassa o alza il titolo della pagina di stampa'
' .FooterMargin = Application.InchesToPoints(0.2) 'abbassa o alza lo scritto sotto la pagine'
' .PrintHeadings = False
' .PrintGridlines = False
' .PrintComments = xlPrintNoComments
' .CenterHorizontally = False
' .CenterVertically = False ' .Orientation = xlLandscape 'stampa in verticale...per stampare in orizzontale sostituisci con =x1portrait'
' .Draft = False
' .PaperSize = xlPaperA4 'tipo di foglio usati per la stampa'
' .FirstPageNumber = xlAutomatic
' .Order = xlDownThenOver
' .BlackAndWhite = False
' .Zoom = 100 'ingrandisce o rimpiccolisce la stampa'
' .PrintErrors = xlPrintErrorsDisplayed
'End With
'Application.ScreenUpdating = True
'If st = "V" Then ActiveWindow.SelectedSheets.PrintPreview
'If st = "S" Then ActiveWindow.SelectedSheets.PrintOut Copies:=cp
If r1 < rt Then
Range(Cells(r1 + 1, 1), Cells(rt, 4)).Select
Selection.Delete Shift:=xlUp
End If
Cells(2, 1).Select
Sheets("archivio").Select
'Sub aggiorna1() 'aggiorna i nominativi, movimenti, entrati e usciti
Dim Gh As Long
Dim Kh As Long
Set sh1 = Worksheets("Archivio")
sh1.Activate
Gh = Cells(Rows.Count, 7).End(xlUp).Row + 1
Range(Cells(3, 7), Cells(Gh, 10)).ClearContents
Kh = Cells(Rows.Count, 11).End(xlUp).Row + 1
Range(Cells(3, 11), Cells(Kh, 14)).ClearContents
For x = 3 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(x, 5) <> "" Then
Cells(x, 3) = Cells(x, 5)
Cells(x, 4) = Cells(x, 6)
Cells(x, 5) = ""
Cells(x, 6) = ""
End If
Next x
Cells(2, 1).Select
Range("A3:F1516").Select 'ordina alfabetico tutti i nomi'
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Archivio").Select
Range("AB3").Select
Selection.AutoFill Destination:=Range("AB3:AB247"), Type:=xlFillDefault
Range("AB3:AB247").Select
Range("B9").Select
ActiveWorkbook.Save
Application.Run "'rubricagedet.xlsm'!confronta" 'fa atticare il codice che si trova nel modulo 4
Application.Run "'rubricagedet.xlsm'!copia_nuovo2" 'fa atticare il codice che si trova nel modulo 4
Application.Run "'rubricagedet.xlsm'!trova1" 'fa attivare il codice che si trova sotto alla fine
Range("B9").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A3").Select
End Sub
Sub trova1() 'rende visibile la finestra per cercare i nomi
If userform1.Visible = False Then userform1.Show False
userform1.Left = 345 'coordinate dove far apparire la finestra destra sinistra
userform1.Top = 200
End Sub
[Modificato da trittico69 24/02/2018 14:44]
excel 2003