cancellari i nomi corrispondenti a tre combinazioni

[trittico69]

Chi mi aiuta a modificare il codice nel file allegato ?
Se si avvia la macro si cancellano tutti i nomi invece si devono cancellare solo gli ultimi due…
e cioè dove I-J e M-N sono uguali e in più anche o il nome o il cogmone...
grazie!
http://www.megaupload.com/?d=IFF4ZA6L

[ricky53]

Ciao,
dovresti inserire il codice direttamente nel forum perchè il file tra poco tempo non sarà più disponibile.

[trittico69]

Codice: Seleziona tutto

Option Explicit

Sub confronta()

Dim G As Range, K As Range, cl As Object, cl2 As Object, _
xx As Integer, yy As Integer, z As Integer, x As Integer, _
y As Integer, zz As Integer
Set G = Range("G2:G65536")
Set K = Range("K2:K65536")
'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 cl In G
    If cl <> "" Then
        cl.Select
        x = Selection.Row
'x è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA G
        Exit For
    End If
Next
y = Cells(65536, 7).End(xlUp).Row
'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 cl2 In K
    If cl2 <> "" Then
        cl2.Select
        xx = Selection.Row
'xx è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA K
        Exit For
    End If
Next
yy = Cells(65536, 11).End(xlUp).Row
'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
End Sub

[trittico69]

http://img710.imageshack.us/i/immaginebhx.jpg/

[ricky53]

Ciao,
il testo della spiegazione non è molto chiaro.
Comunque sei sicuro dell'operatore "Or" nell'istruzione

Codice: Seleziona tutto

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)

non dovrebbe essere un "And" ???

[trittico69]

[trittico69]

se metto and non mi cancella nulla..o meglio solo nome e cognome nella seconda riga

[trittico69]

scusate ma è la prima volta che metto immagini su forum

[trittico69]

forse cosi si vede meglio

[trittico69]

[URL=http://img340.imageshack.us/i/immaginexta.jpg/]

[ricky53]

Ciao,
se metti alcune informazioni in questo forum ed altre negli altri non ne usciamo.
Io preferisco continuare a risponderti sull'altro perchè in quello siamo andati più avanti.

Una volta che avrai risolto ti chiedo la cortesia di riportare in questo forum come avrai risolto.

[Anthony47]

Concordo con quanto dice Ricky sulla tecnica del cross posting, anche perche' cosi' facendo spesso non rispondi alle domande che ti facciamo su questo forum (perche' adotti una soluzione propostta su altro forum), salvo tornare e chiederci perche' le soluzioni che adotti non funzionano...

Cio' detto, per me devi modificare qui:

Codice: Seleziona tutto

    For zz = xx To yy   '<<<Questa e' buona, modificate le prossime due righe
        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   'Questa e' buona

Ciao

[trittico69]

sebmbra andare bene....grazie!

[trittico69]

ancora una modifica...sempre in questo codice

Codice: Seleziona tutto

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(1500, 7).End(xlUp).Row + 1
    Else
        y = Cells(1500, 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(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 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, Header:=xlGuess
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

ho messo dele formule in R1-R2-S1-S2 ma il codice sopra me le cancella...potete dirmi la modifica che devo fare in modo che questo non accada?
grazie!

[trittico69]

anche perchè il tutto a me finisce in Q2 dopo tutte le celle sono vuote e quindi ho messo delle formule

[Anthony47]

Se parli del foglio Archivio allora queste istruzioni usano le celle R1:T2 per alcuni calcoli e poi cancellano tutto.

Codice: Seleziona tutto

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


Dovresti coordinare l' uso delle celle con formule con l' uso delle celle nel vba; se non sai cosa fa il vba potresti provare a spostare "un po' piu' a destra" le tue formule, oppure su un altro foglio non lavorato dal vba.
Oppure, per una prova alla cieca, sostituisci tutto il blocco di sopra in

Codice: Seleziona tutto

r1=Cells(Rows.Count, 5).End(xlUp).Row
If Cells(Rows.Count, 5).End(xlUp).Row > r then r=Cells(Rows.Count, 5).End(xlUp).Row
If Cells(Rows.Count, 7).End(xlUp).Row > r then r=Cells(Rows.Count, 7).End(xlUp).Row
If Cells(Rows.Count, 11).End(xlUp).Row > r then r=Cells(Rows.Count, 11).End(xlUp).Row


Ciao

[trittico69]

ok capito....preferisco farlo su un altro foglio....