Trova celle che contengono duplicati DENTRO STRINGA DI TESTO

[christianghz]

Ciao a tutti,
ho un file con una colonna che contiene dei codici prodotto singoli o raggruppati nella stessa cella, es.:

1 cod1
2 cod2
3 cod3 cod4 cod5
4 cod 6
5 cod7 cod8

In questa colonna quotidianamente faccio un importazione di nuovi codici da un file che però contiene anche codici già importati in precedenza e magari raggruppati con altri codici all'interno della stessa cella appunto.
Io ho una macro che se il codice è già presente elimina la riga prima di importarla, ma il codice deve essere singolo nelle celle così riconosce il duplicato, se invece nel mio foglio di destino è già presente ma raggruppato con altri codici ovviamente non trova il duplicato e inserisce una nuova riga, portandomi a una situazione come questa:

1 cod1
2 cod2
3 cod3 cod4 cod5
4 cod 6
5 cod7 cod8
6 cod4

esiste un codice che cerchi valori già presenti nella stringhe di testo delle altre celle e mi avvisi di quale si tratta e dove? o che mi elimini già la riga che sto per importare (o che ho importato) che contiene un codice già presente in un'altra cella?

trovo solo codici per cercare valori duplicati, ma non è questo il caso.


grazie

[Anthony47]

Huumm...
Dovresti pero' allegare il codice della macro che usi per l'importazione quotidiana e il controllo e un esempio di file che importi; inoltre chiarire se il file che quotidiano puo' contenere piu' codici nella stessa riga, es "cod4 cod7 cod10", e il comportamento da mantenere in questi casi.

Ciao

[christianghz]

Ciao Anthony,
ok, cerco di essere breve e chiaro, perchè non sono un buon scrittore di vba quindi per voi sarà farraginoso immagino.

Questa è la macro complessiva, che unisce in un'unica riga i codici uguali presenti nel foglio che desidero importare, li inserisce nel file di destino "RITIRI", e lì poi raggruppa in un'unica riga alcuni codici diversi in base a caratteristiche presenti in colonna BO:

Codice: Seleziona tutto

Sub Importa_Ritiri() 'nome macro principale, il codice seguente è la macro Importa_in_ConsRit_Multi
Dim LastA As Long, Last1 As Long, SummaSh, Cnt As Long, Rispo
Dim dayWkb, yNext As Long, myCopy As Boolean, myMsg As String

'
Application.ScreenUpdating = False
Set SummaSh = Workbooks("RITIRI.xlsm").Sheets("RITIRI")       '<<< Il File e foglio dell' Annuale su cui fare la somma
'
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Clear
    .Filters.Add "Excel", "*.xls*", 1
    .Show
    If .SelectedItems.Count = 0 Then
         MsgBox ("Nessuna voce selezionata, procedura annullata")
         GoTo exitA
    End If
End With
'
For Each dayWkb In Application.FileDialog(msoFileDialogFilePicker).SelectedItems     'Directory e Nome del file selezionato
    Workbooks.Open dayWkb


 Sheets.Add After:=ActiveSheet 'aggiungo un foglio e ci copio i dati del foglio1
    Sheets("Foglio1").Select
    Cells.Select
    Selection.Copy
    Sheets("Foglio2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
       
    Columns("A:A").Select 'inserisco una colonna all'inizio del foglio e ci copio il valore della colonna "Data conferimento" perchè Mappoint sulla prima colonna vuole un numero e se invece ha il numero di spedizione che inizia per IT dà problemi
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Numero data per Mappoint che se no si blocca"
    Range("A2").Select
   
    Call Abbrevia_nomi
       
        Application.DisplayAlerts = False 'tolgo richiesta di conferma eliminazione fogli altrimenti me lo chiede sempre
          Sheets("Foglio1").Select 'ELIMINO FOGLIO1
    ActiveWindow.SelectedSheets.Delete
        Sheets("Foglio2").Select
        Application.DisplayAlerts = True
       
        Range("AH2").Select 'inserisco numero plt
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-32]="""","""",1)"
        Range("AH2").Select
   Selection.AutoFill Destination:=Range("AH2:AH5000"), Type:=xlFillDefault
        Range("AH2").Select
       
    Cells.Select 'incollo valori foglio
   ' Range("A1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
        Range("A2").Select
       
       
' ** elimino righe che hanno stato ritiro (colonna  52 AZ) DIVERSO da vuoto:
Dim ur As Integer
With Sheets("Foglio2")
ur = .Cells(Rows.Count, 1).End(xlUp).Row
For n = ur To 2 Step -1
If .Cells(n, 53).Value <> "" Then ' And .Cells(n, 6).Value <> "tped" ' aggiungere And. .... prima di Then se devo fare altri filtri
.Cells(n, 53).EntireRow.Delete
End If
Next n
End With


'inserisco concatenazione misure in modo da averle raggruppate in unica cella poi

       
   Range("AP2").Select  'lungxlargx H x KG
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-5],""x"",RC[-4],""x H"",RC[-3],"" Kg"",RC[-2],"";"")"
    Range("AP2").Select
    Selection.AutoFill Destination:=Range("AP2:AP5000"), Type:=xlFillDefault
    Range("AP2:AP5000").Select
    Columns("AP:AP").Select
    Selection.Copy 'copio incollo valori
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AP6").Select
    Application.CutCopyMode = False
   
   

' ** elimino righe che hanno CONCESSIONARIO ritiro DIVERSO da 001  (colonna 6   (F) ) :
With Sheets("Foglio2")
ur = .Cells(Rows.Count, 1).End(xlUp).Row
For n = ur To 2 Step -1
If .Cells(n, 7).Value <> "001 - " Then ' And .Cells(n, 7).Value <> "tped" ' aggiungere And. .... prima di Then se devo fare altri filtri
.Cells(n, 7).EntireRow.Delete
End If
Next n
End With
 

 
  Call UnisciSpedizioniSemplificato
 
 
 





'importo le righe:

        Sheets(1).Activate: myCopy = True
       
        'le seguenti righe controllano se nella colonna A è già presente il codice e ti chiede se vuoi importare lo stesso, serviva per il file delle navette qui non serve perchè elimino giusto qui sopra le spedizioni con stato vuoto e al max le reinserisco.
   ' Cnt = Application.WorksheetFunction.CountIf(SummaSh.Range("A:A"), Range("A2").Value)
   ' If Cnt > 0 Then
     '   Rispo = MsgBox("ATTENZIONE!! L'ID Trazione che stai provando a importare e' gia' presente nel file ELENCO CONSEGNE (" & Cnt & "volte)" & _
     '   vbCrLf & "Vuoi procedere comunque alla copia?", vbYesNo)
      '  If Rispo = vbYes Then myCopy = True Else myCopy = False
   ' End If
   
    If myCopy Then
        LastA = Cells(Rows.Count, 1).End(xlUp).Row
        Last1 = Cells(1, Columns.Count).End(xlToLeft).Column
       '  myMsg = myMsg & vbCrLf & ActiveWorkbook.Name & ":FATTO!!! copiate " & (LastA - 1) & " righe" 'riattivare se voglio messagio della copia fatta a metà della macro
       
        yNext = SummaSh.Cells(SummaSh.Rows.Count, 1).End(xlUp).Row + 1
        Range("A2").Resize(LastA - 1, Last1).Copy SummaSh.Cells(yNext, 1)
    Else
        myMsg = myMsg & vbCrLf & ActiveWorkbook.Name & ": >>> NON COPIATO! "
    End If
    ActiveWorkbook.Close False
Next dayWkb

'MsgBox (myMsg & vbCrLf _
 '    & "Salvare il file RITIRI") ' attivare queste due righe se si vuole un messaggio metà macro
exitA:
Set SummaSh = Nothing


 Cells.Select   'metto tutte le righe a H 15 perchè me le ingrandiva con l'importazione
    Range("R1").Activate
    Selection.RowHeight = 15
    Range("R2").Select
   
   
     Cells.Select 'tolgo i bordi blu dalle celle  perchè me li mette con l'importazione
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A2").Select




Call Formule_Rit
Call UnisciSpedizioniSemplificato_Ritiri2

  ' ** elimino righe che hanno numero spedizione vuoto perchè mi lascia le date in colonna A dopo aver eliminato le righe (colonna  52 AZ) DIVERSO da vuoto:
With Sheets("RITIRI")
ur = .Cells(Rows.Count, 1).End(xlUp).Row
For n = ur To 2 Step -1
If .Cells(n, 2).Value = "" Then ' And .Cells(n, 6).Value <> "tped" ' aggiungere And. .... prima di Then se devo fare altri filtri
.Cells(n, 2).EntireRow.Delete
End If
Next n
End With

Call Copia_ritiri_foglio_dati
 

Application.ScreenUpdating = True
dimmi = MsgBox("Fatto! importati " & (LastA - 1) & " Ritiri da effettuare. Alcuni sono stati raggruppati. Salva il file dei RITIRI e aggiorna Mappoint.", vbInformation)
End Sub



Questa di seguito è la macro UnisciSpedizioniSemplificato che chiamo circa a metà del codice sopra, con cui raggruppo in un unica riga i codici uguali presenti nel file che sto per importare (IMPORT) nel file di destino denominato "RITIRI":

Codice: Seleziona tutto

Sub UnisciSpedizioniSemplificato()
' UNISCO LE SPEDIZIONI IN BASE AL CODICE SPED


vert = Cells(Rows.Count, 1).End(xlUp).Row
oriz = Cells(1, 1).End(xlToRight).Column
Range(Cells(1, 1), Cells(vert, oriz)).Select
' di seguito la colonna che determina i doppioni è la colonna B (2), dalla riga 2
Selection.Sort Key1:=Cells(2, 2), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Y = 1 To vert
    If Cells(Y, 2) <> "" Then
        If Cells(Y, 2) = Cells(Y + 1, 2) Then
            For jj = 1 To Application.WorksheetFunction.CountIf(Cells(Y + 1, 2).Resize(vert, 2), Cells(Y, 2).Value)
                Cells(Y, 36) = Cells(Y, 36) + Space(1) + Cells(Y + jj, 36) ' unisco i nomi dei formati delle stesse spedizioni di colonna AJ
                Cells(Y, 42) = Cells(Y, 42) + Space(1) + Cells(Y + jj, 42) ' unisco LE DIMENSIONI CONCATENATE DEI VARI PLT (COLONNA AP)
                Cells(Y, 40) = Cells(Y, 40) + Cells(Y + jj, 40) 'faccio la somma dei pesi dei vari bancali che sono in colonna  AN
                Cells(Y, 34) = Cells(Y, 34) + Cells(Y + jj, 34) 'Sommo i plt della spedizione
                Range(Cells(Y + jj, 1), Cells(Y + jj, oriz)).ClearContents
                DoEvents
            Next jj
        End If
    End If
Next Y
Range(Cells(1, 1), Cells(vert, oriz)).Select
Selection.Sort Key1:=Cells(2, 2), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(1, 1).Select
End Sub

Quest'altra di seguito invece è la macro UnisciSpedizioniSemplificato_Ritiri2 che chiamo alla fine del primo codice in alto, che nel file di destino "RITIRI" raggruppa i codici della colonna B in unica riga anche se diversi, in base a dei valori contenuti in colonna BO (67)

Codice: Seleziona tutto

Sub UnisciSpedizioniSemplificato_Ritiri2()
'vert = Cells(Rows.Count, 67).End(xlUp).Row
'oriz = Cells(1, 67).End(xlToRight).Column

vert = Cells(Rows.Count, 2).End(xlUp).Row
oriz = Cells(1, 1).End(xlToRight).Column


Range(Cells(1, 2), Cells(vert, oriz)).Select
Selection.Sort Key1:=Cells(2, 67), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Y = 1 To vert
    If Cells(Y, 67) <> "" Then
        If Cells(Y, 67) = Cells(Y + 1, 67) Then
            For jj = 1 To Application.WorksheetFunction.CountIf(Cells(Y + 1, 67).Resize(vert, 1), Cells(Y, 67).Value)
                Cells(Y, 36) = Cells(Y, 36) + Space(1) + Cells(Y + jj, 36) ' unisco i nomi dei formati delle stesse spedizioni di colonna AI 35
                Cells(Y, 21) = Cells(Y, 21) + Space(1) + Cells(Y + jj, 21) ' unisco le note dei vari ritiri colonna T -20
                Cells(Y, 22) = Cells(Y, 22) + Space(1) + Cells(Y + jj, 22) ' unisco i luoghi di consegna
                Cells(Y, 2) = Cells(Y, 2) + Space(1) + Cells(Y + jj, 2) ' unisco i codici di spedizione di ritiri uguali
                Cells(Y, 42) = Cells(Y, 42) + Space(1) + Cells(Y + jj, 42) ' unisco LE DIMENSIONI CONCATENATE DEI VARI PLT (COLONNA AO)
                Cells(Y, 40) = Cells(Y, 40) + Cells(Y + jj, 40) 'faccio la somma dei pesi dei vari bancali che sono in colonna 39 AM
                Cells(Y, 64) = Cells(Y, 64) + Cells(Y + jj, 64) 'Sommo i plt della spedizione
                Range(Cells(Y + jj, 2), Cells(Y + jj, oriz)).ClearContents
                DoEvents
            Next jj
        End If
    End If
Next Y
Range(Cells(1, 2), Cells(vert, oriz)).Select 'dalla riga seguente decido la colonna di riferimento per l'ordinamento delle righe
Selection.Sort Key1:=Cells(2, 2), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(1, 1).Select
End Sub




a questo punto mi troverò nel foglio di destino "RITIRI" delle righe che contengono in alcune celle della colonna B più codici diversi.

Se nella successiva importazione porterò dentro dei codici già presenti in una di queste celle che contengono codici multipli, La mia macro non li vedrà già presenti perchè raggruppati con altri codici appunto e mi creerà una nuova riga con quel singolo codice.

Spero sia chiaro,
https://we.tl/EcOznCnwMP qui un file di esempio che importo generalmente.

[christianghz]

Quello di cui ho bisogno come detto sopra è che NON importi di nuovo quel codice.

[Anthony47]

Non ho decodificato completamente il tuo processo, nemmeno guardando quello che hai fatto; vado quindi con un suggerimento di principio.

Da qualche parte controlli che il codice nuovo che vuoi inserire sia gia' presente in qualche colonna di un foglio noto del file RITIRI (non ho capito dove lo fai); il problema e' che la colonna contiene codici concatenati separati da uno spazio.
Allora:
-inserisci un nuovo foglio, che chiami "ZCZY33" (o altro nome che certamente non ci sara' mai nel tuo file)
-copi la colonna coi codici concatenati e la incolli in A1 del foglio ZCZCY33
-fai un testo-in-colonna del contenuto di colonna A
-a questo punto invece di controllare "che il codice nuovo che vuoi inserire sia gia' presente in qualche colonna di un foglio noto del file RITIRI" controlli che sia gia' presente nel foglio ZCZY33.
-prima di terminare il processo elimini il foglio ZCZY33

Questo potrebbe corrispondere ai seguenti spezzoni di codice:

Codice: Seleziona tutto

'Crea il nuovo foglio ZCZY33:
Dim fCodici As Range, aSh As Worksheet
Set aSh = ActiveSheet
Set fCodici = ThisWorkbook.Sheets("Foglio1").Range("E:E")     '<<< Il foglio con i codici concatenati e la colonna
ThisWorkbook.Sheets.Add before:=Sheets(1)
ThisWorkbook.Sheets(1).Name = "ZCZY33"
aSh.Activate


Codice: Seleziona tutto

'Copia la colonna con codici concatenati nel nuovo foglio e fa Testo-in-Colonne:
fCodici.Copy
ThisWorkbook.Sheets("ZCZY33").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ThisWorkbook.Sheets("ZCZY33").Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True


Codice: Seleziona tutto

'Controlla se un certo codice e' presente in foglio ZCY33:
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("ZCZY33").UsedRange, CodiceDaControllare) = 0 Then
'
'cosa fare se il codice non e' ancora presente
'
End If


Codice: Seleziona tutto

'Elimina il foglio di servizio:
Application.DisplayAlerts = False
ThisWorkbook.Sheets("ZCZY33").Delete
Application.DisplayAlerts = True


Vedi se concettualmente ti torna e se riesci a utilizzarlo nel tuo contesto; se invece non torna allora ci ragioneremo sopra insieme.

Ciao

[christianghz]

Ciao Anthony

i codici da controllare sono tutti quelli che sto per importare, non ho capito dove il codice di seguito prenderebbe il "CodiceDaControllare" visto che sono molteplici e sempre diversi:

Codice: Seleziona tutto

If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("ZCZY33").UsedRange, CodiceDaControllare) = 0 Then

comunque il resto ok ti ringrazio, pensavo ci fosse un codice più diretto che controllava i codici che sto per importare nel contenuto delle celle del foglio che su cui sto per importare.

[Anthony47]

Rieccomi (anche se immagino che adesso sarai tu in vacanza)...

Come detto io non ho capito il dettaglio del tuo processo, quidi nei dettagli non so andare.
Dici che "i codici da controllare sono tutti quelli che sto per importare", ma li importerai uno alla volta; quindi invece di CodiceDaControllare userai un riferimento al singolo codice che stai importando in quel momento.
Sapendo in quale riga controlli /vorresti controllare se il codice e' gia' presente non dovrebbe essere difficile trovare il riferimento; ma se non riesci ad adattare da solo indicami in quale spezzone di codice fai quel controllo e vedremo insieme come procedere.

Ciao