Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Range A2:F2 si inverte con A3:F3

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Range A2:F2 si inverte con A3:F3

Postdi trittico69 » 07/03/11 22:24

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?


Codice:
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 = "$1:$2"
.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
trittico69
Utente Senior
 
Post: 487
Iscritto il: 16/08/09 18:41

Sponsor
 

Re: Range A2:F2 si inverte con A3:F3

Postdi Anthony47 » 07/03/11 23:37

Metti un break sulla riga Selection.Sort Key1:=Range("A3" ), Order1:=xlAscending e controlla in quel momento quale e' il range di celle in quel momento selezionato.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Range A2:F2 si inverte con A3:F3

Postdi Flash30005 » 07/03/11 23:41

Molto probabilmente il valore "d" che usi è minore di 3 (magari 2)
Quindi dovrai mettere una condizione che
Se d < 3 allora d = 3
tradotto
Codice: Seleziona tutto
If d <3 then d = 3

vedrai che così facendo non "inverte" più la formula

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-


Torna a Applicazioni Office Windows


Topic correlati a "Range A2:F2 si inverte con A3:F3":


Chi c’è in linea

Visitano il forum: Nessuno e 10 ospiti

cron