Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

visualizzare tutti i passaggi di una macro

Ultimo Aggiornamento: 24/04/2018 19:24
Post: 222
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
24/02/2018 14:37

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
Post: 2.059
Registrato il: 21/03/2008
Città: LOCATE VARESINO
Età: 76
Utente Veteran
2007 / 13
OFFLINE
24/02/2018 14:43

ciao

avvia la macro con il tasto ( F8 ) sequenza passo passo

Ciao da locate
excel 2007 / 13
Post: 222
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
24/02/2018 14:46

fatto mq quando arriva qui
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

torna sempre indietro.
come faccio per fargli compiere il ciclo velocemente?
excel 2003
Post: 4.059
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
24/02/2018 18:10

dopo più di 200 post non hai ancora capito che il codice va messo tra i tag code e che occorre allegare un file di esempio, specialmente in caso di codice così lungo. Chi vuoi che te lo legga tutto ?

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 661
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
24/02/2018 19:07

Oltre al tasto F8 che serve per avanzare di una riga alla volta e al tasto F5 che serve per completare il resto della macro nel caso in cui si decida che non è più necessario procedere riga per riga c'è sempre la possibilità di usare il tasto F9 per inserire un Punto di Interruzione.
Nel caso specifico puoi attivare il punto di Interruzione sulla prima riga di codice subito dopo il For/Next che stai controllando; quando hai visto quello che ti serve puoi rapidamente completare il For/Next premendo F5 e la macro si fermerà sul Punto di Interruzione da dove puoi nuovamente procedere riga per riga con F8.
Puoi inserire più Punti di Interruzione e si tolgono allo stesso modo.
Ma queste sono informazione elementari/base per la gestione del VBA ... e dare un'occhiata ad un manualetto ?

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 223
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
18/03/2018 16:06

ciao rollis, non riesco piu a trovare la discussione dove parlavamo di
far partire la macro "conta minuti" tramite la variazione di una cella.

Private Sub Worksheet_Calculate() ' serve a far avviare la macro minuti quando si copiano e incollano piu celle contemporaneamnete altrimenti la macro minuti si avvierebbe solo inserendo i sevizi giorno per giorno

If oldM8 <> Range("M8").Value Then 'se m8 cambia valore fa partire la macro minuti
oldM8 = Range("M8").Value
Call minuti
End If

End Sub
[Modificato da trittico69 18/03/2018 16:06]
excel 2003
Post: 224
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
18/03/2018 16:44

Ti accenno comunque il problema qui.
Ti allego il file, se metti ad esempio nel foglio “feb” l’orario 08:00-16:00, il 03 febbraio, in M8 cambia il valore, ma non parte la macro “minuti” nel modulo 1.
Poi se riesci a far si che la protezione del foglio non si metta (non capisco come) in automatic
Esempio se vai nel foglio “gen” e provi a cancellare i commenti delle celle selezionate non lo fa peche c’è la protezione.
Ebbene tolgo la protezione, cancello i commenti, salvo, chiudo il file, lo riapro e la protezione non c’è, ma il giorno dopo quando riapro il file la protezione torna.
excel 2003
Post: 670
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
18/03/2018 23:18

A parte il fatto che la macro "minuti" si trova nel Modulo2 e non nel Modulo1 mi risulta che viene seguita correttamente al cambiare del valore della cella M8 come previsto dal "Worksheet_Calculate" nel Modulo del foglio in uso.
Per accertartene da solo ti basta mettere uno "Stop" all'inizio della macro "Worksheet_Calculate" e quando il VBA si ferma in modalità Debug prosegui con il tasto F8 riga per riga (F5 per completare velocemente) e vedrai che al cambio del valore di M8 effettivamente parte la macro "minuti"; potrai contestualmente verificare anche i valori assunti dalla variabile "oldM8" e dalla cella M8 per valutarne la corretta esecuzione.

Per quanto riguarda la protezione del foglio è giusto che questa si riattivi, ovvero, ogni qualvolta viene avviata la macro "minuti" per un qualsiasi motivo, dato che verso la fine c'è il comando "ActiveSheet.Protect", giustamente viene nuovamente protetto il foglio come richiesto.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 225
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
19/03/2018 08:20

si scusa ho sbagliato a digitare il numero del modulo..
Appena ho tempo provo come mi hai consigliato...ma allora perche a me a volte non parte la macro minuti e a volte si? Oppure se parte non mi varia il valore nelle tre celle corrispondenti...quale altro morivo potrebbe esserci se poi invio il file a te e funziona?
[Modificato da trittico69 19/03/2018 09:59]
excel 2003
Post: 226
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
19/03/2018 09:58

si scusa ho sbagliato a digitare il numero del modulo..
excel 2003
Post: 227
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
19/03/2018 10:09

allora vediamo se ho fatto bene.
mi sono messo sul rigo
Private Sub Worksheet_Calculate()
del foglio "feb"
ho cliccato f9 e la riga si è evidenziata in viola
ho modificato un valore in una cella del foglio "feb"
e il valore di m8 è cambiato ma la macro minuti non si è avviata in pratica non è successo nulla.
dove sbaglio?
excel 2003
Post: 671
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
19/03/2018 23:09

Ok per F9, puoi anche usare il mouse cliccando più a sinistra sul bordo laterale.

Se non si avvia la macro l'unico motivo che mi viene in mente è che hai l'Opzione di Calcolo impostata a Manuale invece di Automatico. Confermo che usando l'ultimo file che hai allegato l'evento si attiva sempre (naturalmente con il calcolo automatico impostato).

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 228
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
20/03/2018 09:17

Quindi se ho capito bene non si capisce perché a volte va e a volte no....nel frattempo ho messo un tasto a ogni foglio con associata la macro in modo che ogni tanto provo a farla partire manualmente.
excel 2003
Post: 3.265
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
20/03/2018 12:18

Ciao a tutti (un saluto a rollis13)
Ho notato che scaricando il files "la protezione non è attiva"
Riprovato a scaricare il files "la protezione è attiva"
Fatto alcune volte e trovo sempre differenze sulla protezione.
Ps. Credo/penso che tutti i files con VBA debbano essere zippati (siano xls o xlsm)
Prova riallegare zippando il files
Excel 2013
Post: 229
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
21/03/2018 13:31

fatto
[Modificato da trittico69 21/03/2018 13:31]
excel 2003
Post: 230
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
21/03/2018 13:40

con 7zip non me lo fa ellegare.
con winrar portable non me lo fa zippare
excel 2003
Post: 672
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
21/03/2018 18:18

Quando usi 7zip devi accertarti di salvare in formato .ZIP e non .7z come proposto di default.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 231
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
23/03/2018 07:32

fatto
excel 2003
Post: 3.274
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
23/03/2018 11:19

Dico la mia, se sbaglio scusate.
1) Le celle con "i commenti", si possono eliminare solamente (una a una). Almeno pure con Excel 2007
2) Il VBA sembra a posto, c'è da correggerlo, mà dove?, per adesso non saprei
3) Scaricato il files (mese Febbraio era sprotetto), salvato sul desktop e riaperto era protetto (va bene accetto).
4) Fatto alcune prove ed a un certo punto (non saprei quando), Application.EnableEvents=True era "disattivato"
5) In Febbraio + in ogni codice ho inserito all'inizio un msgbox col titolo Ex MsgBox "febbraio", MsgBox "minuti"
6) Chiudo salvo e riapro e faccio prove. Ogni volta la Sub Minuti()=2 volte + altre cose strane.

Conclusione, assomiglia ad un cane che tenta di mordersi la coda.
Tra Worksheet_Calculate, Workbook_SheetChange e sono pure convinto delle Function
Devo dire che ogni volta che si digita un qualcosa (due macro si attivano Calculate+Change), non ricordo in quale ordine
Io proverei con una Public oldM8 as double (varia solamente al fabbisogno ed eluderla nel SheetChange se NON è uguale)
Sicuramente rollis13 (ciao) mi ha capito, casomai appena ho tempo ci riprovo.
Ps. Le Function, credo variano "il valore ogni giorno", pertanto partono insieme altri due codici
Ho trovato come eliminare tutti i commenti, togli protezione.
Premi trova e selezione, scegli commenti e dopo premi elimina commenti
[Modificato da raffaele1953 23/03/2018 13:49]
Excel 2013
Post: 3.275
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
23/03/2018 17:06

Personalmente proverei in questo modo per vedere se funziona bene
1) Eliminare in tutti i fogli "mensili" il Worksheet_Calculate
2) In ogni "mensile" metterei
vb
Option Explicit
Private Sub Worksheet_Activate()
    oldM8 = ActiveSheet.Range("M8").Value
    MsgBox oldM8 ' per adesso solo in FEB+MAR
End Sub

3) Nel Modulo1 aggiungerei
vb
Option Explicit
Public oldM8 As Double
Sub Auto_Open()
MsgBox "Auto_Open"
If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then
    oldM8 = ActiveSheet.Range("M8").Value
Else
    MsgBox "La variabile (oldM8) non è valorizzata, selezionare il (Foglio) mensile corretto"
End If
End Sub

4) La parte finale del SheetChange
vb
Fine:
MsgBox ActiveSheet.Range("M8").Value
If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then
    If oldM8 <> ActiveSheet.Range("M8").Value Then
        Call minuti
        oldM8 = ActiveSheet.Range("M8").Value
    End If
End If

5) In "RIEP", non capisco le date in F20:F21 + F32:F36 + la formula di ogni mensile in AR1
Ps Quando sei sicuro e non desideri più i MSGBOX li togli (premi CTRL+ALT+Pause) e sei già sulla riga VBA
[Modificato da raffaele1953 24/03/2018 09:57]
Excel 2013
Post: 232
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
26/03/2018 13:00

raffaele ho provato i tuoi suggerimenti ma i valori in F10:H10 non variano lo stesso ameno che non abbia sbagliato qualcosa.
ti riallego il file.
non mi allega più neanche in formato .zip
te lo riallego non zippato
[Modificato da trittico69 26/03/2018 13:02]
excel 2003
Post: 3.281
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
26/03/2018 16:28

Il motivo che hai messo >>>If Target.Count > 1 Then Exit Sub
Come già scritto, >>>Application.EnableEvents=True era "disattivato"
Non conosco e non trovo il perchè. Ho sostituito Application.EnableEvents con...
vb
Static bLoop As Boolean ' PER NON USARE Application.EnableEvents
  If Not bLoop Then 
      bLoop = True
      ISTRUZIONE 'Target.ClearContents
      bLoop = False
   End If

Suggerisco di lasciare i Msgbox sino quando sei sicuro al 100% che funzioni
Vero = Application.EnableEvents >>>attivo
Excel 2013
Post: 233
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
27/03/2018 07:49

Per adesso sembra andare bene ma nel frattempo ho riscontrato un errore che avevo già segnalato a rollis, adesso non so se deriva dal fatto delle modifiche apportate da te.
Allego un file, copia tutto e incollalo a partire da B14 nel foglio “Gen”
Esce un avviso di messaggio che non dovrebbe uscire perché non si crea la condizione richiesta e cioè che non mi permette di scrivere nelle colonne C e D se nella stessa riga nella colnna J non sia vuota.
excel 2003
Post: 3.283
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
27/03/2018 14:10

Ho riprovato il tutto, a parte l'errore (foto, niente di particolare)
Allora immettendo un dato o diverse celle interviene il Workbook_SheetChange
Nel caso fosse una sola cella tutto andava bene (io provavo ex C14:U18 in C23 ed era OK)
Nel caso di diverse celle/colonne, ad un certo punto partiva la Sub Minuti()
Questa appena scrive nelle colonne AG,AH,AI intervengono le "function" bloccando la Sub Minuti che non terminava e Application.EnableEvents rimaneva disabilitato
Non sò quale "function" sia incriminata (presumo Domenica oppure Festività).
Ripristinato If Target.Count > 1 Then Exit Sub
Eliminato il VBA in ogni foglio
Riesumato Application.EnableEvents
Adesso rimangono solo queste possibilita:
1) Scrivi una cella per volta
2) Togli le "function" e metti delle formule
3) Ti appoggi ad un bottone per calcolare
Alcune prove fatte col bottone e mi sembra a posto
[Modificato da raffaele1953 27/03/2018 21:53]
Excel 2013
Post: 246
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
23/04/2018 14:44

ok, nel frattempo ho rivelato un altro piccolo problema.
se scrivo, manualmente, un numero in J12 e poi clicco su un foglio qualsiasi mi da errore questa riga
If Not Intersect(Target, [I14:I57]) Is Nothing Then
in thisworkbook
excel 2003
Post: 682
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
24/04/2018 00:46

Giustamente ti va in errore; se modifichi una cella in un foglio senza confermare con un Invio o con le frecce o con il Tab e passi con il mouse direttamente ad un altro foglio ti ritrovi che il Target ha un primo riferimento alle coordinate della cella nel foglio che stai modificando ma poi cambi al volo il riferimento del Foglio e questo 'non è cosa buona'. In pratica nella riga di codice il "[I14:I57]" risulta in bilico tra il primo ed il secondo foglio e pertanto segnala un errore.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 247
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
24/04/2018 07:48

Si può risolvere con qualche formula qualche codice?
excel 2003
Post: 683
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
24/04/2018 18:56

E' semplice, ed è una caratteristica di Excel ... BISOGNA confermare le modifiche alle celle prima di passare altrove.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 248
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
24/04/2018 19:24

Sì, il problema è che volevo dare ai miei colleghi il file e siccome siamo tanti e molti di noi non capiamo il funzionamento di Exel, chiedevo se c'era la possibilità con qualche codice di ovviare a questa problematica.
excel 2003
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 03:36. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com