Oppure

Loading
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?


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