Exell trova numeri in un riquadro e cancella nell'altro

[shakespea]

Salve mi sono appena registrata perchè ritengo che possiate essere gli unici ad aiutarmi.
Ho necessità di creare un foglio excel dove ho un riquadro largho 5 colonne dove poi andro ad aumentare di volta in volta le righe.
sotto al mio inserimento manuale si devono cancellare tutti i numeri doppi
Es:
prima
15 20 36 78 90
18 30 78 22 87
1 12 33 15 19
dopo
15 20 36 78 90
18 30 -- 22 87
01 12 33 ---19


Come si puo vedere nel "dopo" si sono cancellati i numeri 15,78 perche erano doppi.
Spero di aver spiegato bene vi ringrazio anticipatamente per qualsiasi aiuto e visto che non sono cosi brava con excel sarei grata se vogliate spiegarmi la formula passo passo.
Grazie mille

[ricky53]

Ciao,
prima di tutto benvenuta nel nostro forum.

Veniamo al tuo quesito:
non mi è chiaro se i dati devono essere
A) riportati (leggi COPIATI) in un'altra posizione (ad esempio sotto quelli inseriti manualmente da te) e poi si devono cancellare i dati duplicati su questi altri dati
oppure
B) la cancellazione deve essere fatta sui numeri che hai inserito tu.

[shakespea]

Ciao grazie della tua risposta.
Cerco di spiegarmi meglio va benissimo sia che via via che inserisco sopra sotto i numeri uguali si cancellano ma va altrettanto bene se hai bisogno di un nuovo riquadro. A me interessa che sopra scrivo e sotto i vecchi numeri si cancellino se doppi, come un tabellone analitico delle estrazioni.
Nel riquadro che andrò a creare che sarà 18 righe x 5 colonne di ogni numero deve risultarne sempre uno mai doppi e se ci sono doppi saranno quelli nelle 17 righe sotto che si cancellano mai nell'ultima che ho inserito. Grazie ancora per l'aiuto e l'interesse.

[ricky53]

Ciao,
NON hai risposto alla mia domanda A) !!!

Allora abbiamo stabilito che nel foglio hai una sola TABELLA di 18 righe x 5 colonne.
Tu inserisci i numeri nella prima riga della tabella.
Vorresti che in automatico venissero cancellati i numeri SE presenti dalla seconda riga fino alla diciottesima?

DOMANDE:
come vengono inseriti i numeri nelle righe successive alla prima?

[shakespea]

Scusa si la risposta è la A i numeri rimangono quelli che inserisco io di volta in volta facendo inserisci riga aggiungo sopra e scrivo i nuovi numeri e i vecchi rimarranno sotto. Continuando ad autocancellarsi. Ora che ci rifletto (correggimi se abaglio) è meglio avere una tabella diciamo A e una B nella A inserisco i numeri io a mano e nella B si eseguno con formula le cancellazioni dei numeri doppi. Tutti i numeri comunque dovranno essere riportati nella tabella B nella stessa posizione della tabella A lasciano un vuoto o lo 0 dove c'erano i numeri doppi . Grazie della pazienza

[ricky53]

Ciao,
avevo già pensato a "Due Tabelle" ma ... da quanto avevi scritto tu non sembrava che le volessi.
La soluzione non si otterrà con una formula (almeno io vedo più comoda e versatile un'altra soluzione e ... più facile per me) ma con del codice in VBA in una macro che è necessario scrivere ... ci penso e ci ritroviamo QUI.

Per il momento la mia proposta è :
Utilizzare una sola riga di "18" celle (Tabella "A") NON dovrai inserire righe
appena scritto l'ultimo numero della prima riga automaticamente i dati finiranno nella prima riga della seconda tabella (Tabella "B")
a questo punto tu potrai scrivere, nella Tabella "A" altri numeri,
terminata la riga i numeri verranno scritti nella Tabella "B", spostando di una riga in basso i numeri presenti e così via.
La macro quando nella Tabella "B", dalla seconda riga in avanti, troverà dei numeri uguali a quelli della prima riga cancellerà i duplicati presenti dalla seconda riga in avanti.

Ti piace la proposta?

[ricky53]

Ciao,
attenzione ho scritto

Utilizzare una sola riga di "18" celle (Tabella "A") NON dovrai inserire righe

invece volevo scrivere

Utilizzare una sola riga di "5" celle (Tabella "A") NON dovrai inserire righe

[shakespea]

Si va benissimo grazie mille attendo con pazienza grazie ancora

[ricky53]

Ciao,
come promesso eccomi qui con una proposta.

Opera come di seguito ti scrivo:

A) apri un nuovo file excel
B) posizionati sul Tab "Foglio1"
C) tasto destro
D) visualizza codice
E) nella pagina che si apre (Editor del Visual Basic) fai click su "Foglio1" in Microsoft Excel Oggetti del "VBAProject"
F) nella finsestra di destra copia il codice che trovi più avanti
G) vai nel "Foglio1"
H) nell'intervallo "B2:F2" scrivi 5 numeri

Leggi i commenti che ho scritto nel codice

Facci sapere come va.

Codice: Seleziona tutto

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:F2")) Is Nothing Then
        If Target.Count > 1 Then
            MsgBox "Operare su una sola cella", vbExclamation
            Exit Sub
        Else
            If Target.Column = 6 And Target <> "" Then
                Dim UR As Integer, I As Integer, J As Integer, K As Integer, Trovati As Integer
                Application.EnableEvents = False
                UR = Range("A" & Rows.Count).End(xlUp).Row
                If Cells(21, "B") = "" Then
' ..........................................................................................................................................
' CAMBIA il testo che viene scritto nelle 5 celle o elimina la seguente istruzione
                    Range("B1") = "Primo": Range("C1") = "Secondo": Range("D1") = "Terzo": Range("E1") = "Quarto": Range("F1") = "Quinto"
' ..........................................................................................................................................
                    Range("B1:F1").Copy Destination:=Range("B21")
                End If
                If UR > 21 Then
                    Range("B22:F22").Insert Shift:=xlDown
                    Range("B2:F2").Copy Destination:=Range("B22")
                    UR = UR + 1
                    Trovati = 0
                    For I = 2 To 6
                        For J = 23 To UR
                            For K = 2 To 6
                                If Cells(J, I) <> "" And Cells(J, I) = Cells(22, K) Then
                                    Cells(J, I) = ""
                                    Trovati = Trovati + 1
                                End If
                            Next K
                        Next J
                    Next I
                Else
                    Range("B2:F2").Copy Destination:=Range("B22")
                End If
               
'......................................................................
' Alla fine delle tue prove elimina le due istruzioni che seguono
                Range("H22:L22").Insert Shift:=xlDown
                Range("B2:F2").Copy Destination:=Range("H22")
'......................................................................

                Range("B2:F2").ClearContents
                UR = Range("A" & Rows.Count).End(xlUp).Row + 1
                If UR < 22 Then
                    UR = 22
                End If
                Cells(UR, "A") = Cells(UR - 1, "A") + 1
                Application.EnableEvents = True
                If Trovati > 0 Then
                    MsgBox "Sono stati trovati: " & Trovati & " numeri uguali", vbInformation
                End If
            End If
        End If
    End If
End Sub

[shakespea]

Grazie è davvero un ottimo lavoro funziona alla grande!!!
Vorrei provare a sottoporti un altro quesito:
dalla tabella definitiva (cioè dove vengono cancellati i numeri) vorrei rintracciare un numero specifico.
Mi spiego meglio in una casella casuale non importa quale io scrivo un numero e vorrei sapere se quello stesso numero c'è nella tabella definitiva di 18x5 numeri.
Pensi si possa fare?
Ti ringrazio ancora tantissimo

[ricky53]

Ciao,
SI PUO' FARE !!!
Per esempio utilizzando la formattazione condizionale.

Allora operiamo in questo modo:

A) ipotizziamo di scrivere il numero da cercare in "H2"

B) seleziona l'intervallo "B22:F39"

C) seleziona la Formattazione Condizionale e in "condizione 1" seleziona "la formula è", quindi, copia

Codice: Seleziona tutto

=E(B22<>""; B22=$H$2)

D) seleziona "formato" ed imposta il colore dello sfondo delle celle (seleziona "Motivo") e dai la conferma con "OK"

E) scrivi in "H2" uno dei numeri presenti nell'intervallo "B22:F39"

Cosa ottieni nella cella che contiene il numero scritto in H2 ???



Quanto descritto è valido per Office 2003, per le versioni successive: ci devi dire quale utilizzi.
La modalità per operare non è proprio la stessa, cambia il punto di partenza "Menu vs Ribbon" e cambia come impostare la formula ma ... provaci se hai il 2010 o il 2013.

[shakespea]

Ti riungrazio tanto per il lavoro che hai fatto.
Funziona che è una meraviglia!!
Alla prossima.
Ciao

[ricky53]

Ciao,
grazie per il riscontro e buon proseguimento.

Alla prossima ... ci trovi sempre qui.

[shakespea]

Ciao sono di nuovo qui a porti un problema.
Ho inserito la formattazione condizionale ( =E(B22<>""; B22=$H$2) ) con questa formula e funziona benissimo applicandola anche ad altro, l'unico problema è che quando vado ad inserire i nuovi 5 numeri sopra nella nostra prima tabella e quindi si aggiornano sotto cancellando i doppi ecco anche qui la formatazione mi scorre non rimane fissa su B22 ma scorre B23 ,B24 e via via che vado ad aggiungere i 5 numeri sopra. Vorrei che rimanesse sempre fissa su B22 . E' possibile?
Ti ringrazio ancora tantissimo.
Ciao

[ricky53]

Ciao,
certo che sé possibile, anzi me ne sarai dovuto accorgere io durante le prove che ho fatto.

Ecco cosa devi fare:
inserisci le seguenti due istruzioni

Codice: Seleziona tutto

                    Range("B23:F23").Copy
                    Range("B22:F22").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                        SkipBlanks:=False, Transpose:=False


tra le due che avevi già

Codice: Seleziona tutto

                    Range("B2:F2").Copy Destination:=Range("B22")
                    UR = UR + 1


ottenendo

Codice: Seleziona tutto

                    Range("B2:F2").Copy Destination:=Range("B22")
                    Range("B23:F23").Copy ' <<=== INSERITA
                    Range("B22:F22").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                        SkipBlanks:=False, Transpose:=False ' <<=== INSERITA
                    UR = UR + 1


[shakespea]

Ciao purtroppo non mi funziona ho eseguito tutto inserendo cosi come lo hai scritto tu ma non va mi da errore.
Sopra mi hai scritto di inserire le seguanti istruzioni tra le DUE che avevo gia ma io ne ho solo una, questa:

Codice: Seleziona tutto

=E(B22<>""; B22=$H$2)

ho anche fatto le varie prove come questa sotto la prende non da errore ma non funziona:

Codice: Seleziona tutto

="Range(""B2:F2"")=E(B22<>""; B22=$H$2):=Range(""B22"")Range(""B23:F23"").Copy '=E(B22<>""; B22=$H$2)Range(""B22:F22"").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _SkipBlanks:=False, Transpose:=False '=E(B22<>""""; B22=$H$2)UR = UR + 1"


Puoi aiutarmi con una formula gia definitiva che posso inserire nella regola di formattazione grazie mille ancora.
Ciao

[ricky53]

Ciao,
non ti sei accorto che le righe che ho riportato sono quelle del codice della macro !!! LA formattazione condizionale ha sintassi diversa !!!
Eh, Eh !!!

Allora: la modifica che ti ho scritto va fatta nel codice della macro e non nelle regole della formattazione condizionale.
Sarà il codice della macro ad impostare la formattazione condizionale con le istruzioni che ti ho scritto.

[shakespea]

Ciao
bhe sinceramente sono un po imbranata e si noterà!!
non avevo capito che dovevo modificare la macro.
Comunque l'ho fatto eseguendo attentamente ma non funziona anzi adesso non aggiorna neanche più i numeri
Questo è quello che ottengo:
Option Explicit


If Not Intersect(Target, Range("B2:F2")) Is Nothing Then
If Target.Count > 1 Then
MsgBox "Operare su una sola cella", vbExclamation
Exit Sub
Else
If Target.Column = 6 And Target <> "" Then
Dim UR As Integer, I As Integer, J As Integer, K As Integer, Trovati As Integer
Application.EnableEvents = False
UR = Range("A" & Rows.Count).End(xlUp).Row
If Cells(21, "B") = "" Then
' ..........................................................................................................................................
' CAMBIA il testo che viene scritto nelle 5 celle o elimina la seguente istruzione
Range("B1") = "Primo": Range("C1") = "Secondo": Range("D1") = "Terzo": Range("E1") = "Quarto": Range("F1") = "Quinto"
' ..........................................................................................................................................
Range("B1:F1").Copy Destination:=Range("B21")
End If
If UR > 21 Then
Range("B22:F22").Insert Shift:=xlDown
Range("B2:F2").Copy Destination:=Range("B22")
UR = UR + 1
Trovati = 0
For I = 2 To 6
For J = 23 To UR
For K = 2 To 6
If Cells(J, I) <> "" And Cells(J, I) = Cells(22, K) Then
Cells(J, I) = ""
Trovati = Trovati + 1
End If
Next K
Next J
Next I
Else
Range("B2:F2").Copy Destination:=Range("B22")
Range("B23:F23").Copy
Range("B22:F22").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:F2").Copy Destination:=Range("B22")
UR = UR + 1
End If
'......................................................................
' Alla fine delle tue prove elimina le due istruzioni che seguono
Range("H22:L22").Insert Shift:=xlDown
Range("B2:F2").Copy Destination:=Range("H22")
'......................................................................

Range("B2:F2").ClearContents
UR = Range("A" & Rows.Count).End(xlUp).Row + 1
If UR < 22 Then
UR = 22
End If
Cells(UR, "A") = Cells(UR - 1, "A") + 1
Application.EnableEvents = True
If Trovati > 0 Then
MsgBox "Sono stati trovati: " & Trovati & " numeri uguali", vbInformation
End If
End If
End If
End If
End Sub


Non voglio disturbare oltre sei atato fin troppo paziente modificherò ogni volta la formattazione condizionale non voglio farti impazzire.
Grazie ancora e a presto!!

[ricky53]

Ciao,
avresti dovuto utilizzare i TAG per il codice !!!
Cortesemente la prossima volta utilizzali.


Vedo che non hai fatto attenzione al codice che ti avevo riportato io per farti capire dove inserire le nuove istruzioni e, quindi, hai inserito nel posto sbagliato le nuove istruzioni.

Ti riporto tutto il codice in questo modo non avrai problemi:

Codice: Seleziona tutto

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:F2")) Is Nothing Then
        If Target.Count > 1 Then
            MsgBox "Operare su una sola cella", vbExclamation
            Exit Sub
        Else
            If Target.Column = 6 And Target <> "" Then
                Dim UR As Integer, I As Integer, J As Integer, K As Integer, Trovati As Integer
                Application.EnableEvents = False
                UR = Range("A" & Rows.Count).End(xlUp).Row
                If Cells(21, "B") = "" Then
' ..........................................................................................................................................
' CAMBIA il testo che viene scritto nelle 5 celle o elimina la seguente istruzione
                    Range("B1") = "Primo": Range("C1") = "Secondo": Range("D1") = "Terzo": Range("E1") = "Quarto": Range("F1") = "Quinto"
' ..........................................................................................................................................
                    Range("B1:F1").Copy Destination:=Range("B21")
                End If
                If UR > 21 Then
                    Range("B22:F22").Insert Shift:=xlDown
                    Range("B2:F2").Copy Destination:=Range("B22")
                   
' QUI .....................................................................................................
                    Range("B23:F23").Copy ' <<=== INSERITA
                    Range("B22:F22").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                        SkipBlanks:=False, Transpose:=False ' <<=== INSERITA
' QUI .....................................................................................................

                    UR = UR + 1
                    Trovati = 0
                    For I = 2 To 6
                        For J = 23 To UR
                            For K = 2 To 6
                                If Cells(J, I) <> "" And Cells(J, I) = Cells(22, K) Then
                                    Cells(J, I) = ""
                                    Trovati = Trovati + 1
                                End If
                            Next K
                        Next J
                    Next I
                Else
                    Range("B2:F2").Copy Destination:=Range("B22")
                End If
               
'......................................................................
' Alla fine delle tue prove elimina le due istruzioni che seguono
                Range("H22:L22").Insert Shift:=xlDown
                Range("B2:F2").Copy Destination:=Range("H22")
'......................................................................

                Range("B2:F2").ClearContents
                UR = Range("A" & Rows.Count).End(xlUp).Row + 1
                If UR < 22 Then
                    UR = 22
                End If
                Cells(UR, "A") = Cells(UR - 1, "A") + 1
                Application.EnableEvents = True
                If Trovati > 0 Then
                    MsgBox "Sono stati trovati: " & Trovati & " numeri uguali", vbInformation
                End If
            End If
        End If
    End If
End Sub


[shakespea]

FUNZIONA!!!
grazie davvero!!
a presto