07/03/11 21:25
trittico69
Non capisco perchè alla fine della macro il Range A2:F2 si inverte con A3:F3….Il cambiamento avviene in questa riga di codice, quando seleziona Range("A3:F" & d).Select
Selection.Sort Key1:=Range("A3", Order1:=xlAscending
Chi mi aiuta?
Selection.Sort Key1:=Range("A3", Order1:=xlAscending
Chi mi aiuta?
Sub sta1() Dim r As Long Dim r1 As Long Dim st As String Dim cp As Long Dim d As Long Dim ind As Variant Dim rr As Long 'ELIMINA GLI ENTRATI E GLI USCITI CHE VENGONO RINOMINATI PERCHE' IL NOME SBAGLIATO E FINISCE A FINE 7 Dim G As Range, KK As Range, cl3 As Object, cl4 As Object, _ xx As Long, yy As Long, z As Long, x As Long, _ y As Long, zz As Long Set G = 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 G If cl3 = "" Then cl3.Select x = Selection.Row Exit For 'If cl3 <> "" Then Else cl3.Select x = Selection.Row 'x è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA G Exit For End If Next If cl3 = "" Then y = Cells(65536, 7).End(xlUp).Row + 1 Else y = Cells(65536, 7).End(xlUp).Row End If 'y è 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(65536, 11).End(xlUp).Row + 1 Else yy = Cells(65536, 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 z = x To y For zz = xx To yy If Cells(z, 9) = Cells(zz, 13) And Cells(z, 10) = Cells(zz, 14) _ And Cells(z, 7) = Cells(zz, 11) Or Cells(z, 8) = Cells(zz, 12) Then Range(Cells(z, 7), Cells(z, 10)).ClearContents Range(Cells(zz, 11), Cells(zz, 14)).ClearContents End If Next zz Next z '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 r = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Dim Condizioni As New Collection Condizioni.Add "F|F" Condizioni.Add "D|D" Condizioni.Add "TR1|TR1" Condizioni.Add "TR2|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(r) As Integer Dim i, j, K, cond Set RNG2 = Range("C3:E" & r) 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 K = i Sheets("ARCHIVIO").Select For i = 1 To K ActiveSheet.Range("A1:F1").Offset(c(i) - 1, 0).Delete For j = i + 1 To K c(j) = c(j) - 1 Next Next 'FINE2 rr = Range("I" & Rows.Count).End(xlUp).Row 'cancella nella colonna entrati il femminile tr1 e tr2 il codice finisce a fine 5 For x = 3 To rr If Cells(x, "I") = "F" Or Cells(x, "I") = "TR1" Or Cells(x, "I") = "TR2" Then Range("G" & x & ":" & "J" & x).ClearContents End If Next x 'fine 5 Range("A3:F" & r).Select 'ordina alfabetico colonna movimenti Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("G3:J170").Select 'ordina alfabetico colonna entrati Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("K3:N34").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("Archivio") 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)" r = Cells(2, 18) Range(Cells(1, 18), Cells(2, 20)).ClearContents If r1 < r Then If r1 = 2 Then Range(Cells(r1 + 1, 1), Cells(r, 4)).Select Selection.Insert shift:=xlDown Cells(4, 5).Copy Range(Cells(r1 + 1, 1), Cells(r, 4)).Select ActiveSheet.Paste Application.CutCopyMode = False Else Range(Cells(r1 + 1, 1), Cells(r, 4)).Select Selection.Insert shift:=xlDown End If End If If r1 < r Then d = r Else d = r1 Range("A3:F" & d).Select Selection.Sort Key1:=Range("A3"), Order1:=xlAscending For x = 3 To d Step 2 Range(Cells(x, 1), Cells(x, 14)).Interior.ColorIndex = 45 ' colora di arancione un rigo si e uno no Next x Range("A3:N" & r).Select 'seleziona l'area di stampa' ind = Range("A3:N" & r).Address ActiveSheet.PageSetup.PrintArea = ind With ActiveSheet.PageSetup .PrintTitleRows = ":" .PrintTitleColumns = "" End With With ActiveSheet.PageSetup .LeftHeader = "Stampato in Data &D - &T Pagine &P/&N" 'stampa data ora e numero di pagine' .CenterHeader = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & _ "&""Arial,Grassetto Corsivo""&18Direzione N.C.P. Solliciano - Firenze&""Arial,Normale""&10" & Chr(10) & _ "&""Arial,Grassetto Corsivo""&12Variazioni Celle, Nuovi Arrivi, Uscite, in Data &D" '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 < r Then Range(Cells(r1 + 1, 1), Cells(r, 4)).Select Selection.Delete shift:=xlUp End If Cells(2, 1).Select End Sub
aaa