You are here:Home-Domande su Excel VBA e MACRO-[RISOLTO] Controllo doppioni
[RISOLTO] Controllo doppioni2019-05-02T10:46:07+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Controllo doppioni

Taggato: 

Visualizzazione 45 filoni di risposte
  • Autore
    Post
    • AvatarKris_9951
      Partecipante
        Post totali: 178

        Salve a tutti,
        ho un piccolo problema con una Macro.
        Cerco di spiegarla bene perché il discorso potrebbe potrebbe sembrare un po’ intrecciato.
        Ho un file Excel con diversi fogli, in ogni foglio ci sono diverse tabelle le quali sono formattate tutte allo stesso modo, ovvero nella colonna “C” c’è il codice prodotto, nella “D” c’è il nome del modello, nella “E” c’è il totale dei prodotti ordinati dal cliente e tra le colonne “F” e “Y” inserisco i numeri di serie di ogni singolo prodotto ordinato dal cliente. Per ogni cliente ho un foglio fatto allo stesso modo, ad esempio:

        se il Cliente1 (che ha un foglio tutto suo) ordina 2 iPhone X io compilo la tabella in questo modo:
        C             D               E           F       G      H      I     L      M     N     O    P    Q    R    S   T   U   V   W   Y
        A     IPHONE X      2          50     51
        Vuol dire che il CODICE “A” il quale è iPhone X è stato ordinato per 2 pezzi ed i seriali che ho deciso di vendergli sono il 50 e 51

        E così via per tutti i prodotti che ogni cliente ordina.
        Ora c’è il problema:
        Nell’esempio il Cliente1 ha ordinato 2 iPhone X ed io ho scritto che gli venderò 2 iPhone X che hanno i numeri di serie 50 e 51; purtroppo succede spesso che per errore scrivo lo stesso seriale dello stesso prodotto a 2 clienti diversi, quindi ad esempio se il Cliente2 ordina  3 iPhone X io non posso dargli quelli che hanno numero seriale 50 e 51 perché sono già stati impegnati per il Cliente1.
        La mia idea è stata quella di avere una Macro che facesse un controllo a tutto il file una volta finito di essere compilato, in modo tale da accorgersi di eventuali doppioni e segnalarmeli cosicché io possa correggerli.
        Una cosa del genere mi è stata fornita da un ragazzo molto bravo con il VBA ma funziona solo se tutti i fogli di lavoro sono esattamente identici tra di loro, mentre a volte capita il contrario…

        Allego 2 file di esempio: 1 ha i fogli tutti uguali e la Macro funziona perfettamente ed un altro file i cui fogli sono diversi tra di loro e la Macro va in errore.
        Per caso c’è qualcuno che riesce a trovare un rimedio  ;-) ?

        Grazie a tutti per l’aiuto  :-)
        https://www.dropbox.com/sh/9efzjqqyr746fih/AACB4PdU-qXzTr67r8xGz7x0a?dl=0

        • Questo topic è stato modificato 1 anno, 7 mesi fa da BySalvBySalv. Motivo: testo illegibile
        • Questo topic è stato modificato 1 anno, 7 mesi fa da sidsid.
      • sidsid
        Moderatore
          Post totali: 752

          Ciao
          Ti ripeto quello che ti ha già detto BySalv in un’altra discussione

          Ciao Kris, non fare copia incolla si porta dietro il formato Html.

          .

          Passiamo al problema

          i cui fogli sono diversi tra di loro

          Cosa intendi con “diversi”? Mi sembra che le tabelle abbiano tutte il range A:AD per le colonne; per le righe invece ogni tabella può averne più di una; forse ti riferisci a questo?

        • AvatarKris_9951
          Partecipante
            Post totali: 178

            Ciao Sid!

            Chiedo scusa, mi ero dimenticato di non poter fare copia/incolla :-(

             

            Per fogli diversi in effetti mi riferisco solo alle righe perché le colonne rispecchiano tutte le stesse regole:

            C – Codice

            D – Modello

            E – Tot prodotti ordinati

            da F a Y – Numeri seriali (massimo 20 per riga)

            da Z in poi ci sono delle formule che fanno dei conteggi ed i valori di quei campi non sono presi in considerazione nella ricerca doppioni

             

            Grazie mille per il supporto :-)

          • BySalvBySalv
            Amministratore del forum
              Post totali: 804

              Ciao Kriss, ed un Saluto a Sid, mi sto rimettendo un poco in carreggiata, ho messo a posto il tuo post per renderlo leggibile.

              ma vorrei farti una domanda, hai per forza bisogno di quella impostazione dei tuoi dati? oltre che essere poco leggibili è un modo farraginoso di assegnare i seriali, ed anche estrarre i dati.

              come avrai forse notato nel file che dici funziona, nel MessageBox i dati vengono ripetuti 2 volte uno con “Cliente1-Cliente2” e l’altro con “Cliente2-Cliente1” per lo stesso prodotto e numero seriale.

              Inoltre la tua impostazione non prevede che un cliente possa ordinare 50 pezzi di uno stesso prodotto non hai colonne disponibili per i seriali, tranne se non crei più righe per lo stesso prodotto, ma questo rende più difficile ricerche e conteggi.

              So che il tuo file è uno stralcio di un file più grande, in quanto per la ricerca del codice la va a fare su un altro foglio non presente nel file.

              L’assegnazione dei seriali dovrebbe essere una cosa sequenziale ed automatica questo renderebbe i duplicati impossibili a generarsi, tranne se il seriale che viene assegnato non faccia parte del codice ISBN che è sulla scatola del prodotto, allora per forza dovrà essere inserito manualmente o con un lettore di codice a barre.

              Comunque ripeto, la tua impostazione è obbligatoria? nel caso non lo sia ti si può proporre una diversa impostazione del tutto, molto più snella ed efficace.

              Ciao By Sal :bye:

              Ciao By Sal (8-)
              se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

            • AvatarKris_9951
              Partecipante
                Post totali: 178

                Buongiorno Sal!

                Hai toccato un tasto veramente dolente :-( perché sono totalmente contrario ad ogni minimo particolare relativo all’impostazione di quel file.

                Purtroppo non è stato “pensato” da me ma da qualcuno rimasto ancora agli anni 70…

                meglio che non dico altro 😭

                purtroppo l’impostazione è quella è non è possibile scendere a compromessi.

                Io vorrei solo limitare i danni il più possibile…

                Per capire a che livello siamo ti rispondo subito su come ci si comporta nel caso in cui il cliente ordina 50 pezzi:

                SI CREANO 3 righe con lo stesso codice. 2 RIGHE DA 20 seriali ED 1 DA 10 seriali 😳🤢🤮

                Ho pubblicato questo post senza nutrire particolari speranze perché molti buoni conoscitori di VBA mi hanno detto che con queste condizioni la cosa è impossibile, quindi capirò benissimo se anche tu arriverai alla stessa conclusione 🥺

                Io ti ringrazio per il supporto e mi scuso ancora per quel fastidioso copia/incolla.

                mi sono completamente dimenticato di evitarlo 🥴

                Grazie mille di nuovo!!

              • BySalvBySalv
                Amministratore del forum
                  Post totali: 804

                  Ciao Kriss, bene stabilito che il formato è obbligatorio, ed anche che quasi niente è impossibile con il VBA, vediamo come si può risolvere il problema, dammi alcune informazioni sul tuo modo(obbligatorio) di operare.

                  la registrazione dei dati come avviene, prendo a modello il tuo file funzionante, cioè un cliente “Cliente 1”, prendi il foglio “Cliente 1” fa un ordine di un codice “a” riga 16 “IPHONEX” di altri 2 ce ne sono già 8 e diventeranno 10, come fai a sapere l’ultimo seriale assegnato? di quel codice.
                  di norma nella tabella dei codice e relativamente ad “IPHONEX” dovrebbe esserci l’ultimo seriale assegnato in una colonna della tabella, se non hai questo dovresti creare una tabella per tenere conto dei codici seriali, oppure aggiungere una colonna alla tabella per i seriali.

                  dimenticavo i seriali sono relativi al quel codice oppure globali, cioe ci sara un 52 IPHONEx ed un 52 GALAXI S10, oppure un progressivo indipendente dal codice.

                  e qui entrerà il VBA, aggiornando il numero 8 a 10, si prende il codice cerca nella tabella vede l’ultimo seriale lo incrementa di 2 e nella registrazione che stai facendo alle colonne successive inserirà i 2 seriali nuovi, nel caso raggiungerà le ultime 2 colonne disponibili.
                  Ammettendo che invece di 2 se ne debbano aggiungere 5, quindi supera il 10, si può fare in 2 modi in primis i primi 2 seriali si inseriranno sulla riga 16, gli altri 3 si crea una nuova riga inserendo gli altri 3, ma sorge un problema, nella prima riga la 16 resta solo 10 o viene scritto 13, e quindi nella nuova riga17 si ripete codice-descriz. e come totale solo 3 oppure la riga 17 riporterà solo i seriali.

                  con questo metodo non dovrai stare a ricordare l’ultimo seriale assegnato e non avrai doppioni.

                  Fai sapere, Ciao By Sal :bye:

                  Ciao By Sal (8-)
                  se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                • AvatarKris_9951
                  Partecipante
                    Post totali: 178

                    Ciao Sal,

                    e qui sorge un altro problema purtroppo:

                    non è detto che i seriali debbano essere necessariamente consecutivi.

                    Ad esempio al Cliente1 ho messo i seriali 55-56 ma potrebbe anche essere che al Cliente1 gli venga dato il 55 e l’80, al Clinte2 il 56 ed il 79 ed al Cliente 3 il 60 e 64; in parole povere anche qui non c’è una logica, o meglio ancora, NON C’E’ UNA REGOLA da rispettare. E’ come se venisse tutto deciso “a caso” oppure secondo un criterio di cui io sono all’oscuro.

                    L’unica cosa che ho pensato è stata quella di una Macro che controllasse il tutto una volta finito di compilare il file ed avvisarmi quanto meno sull’esistenza di doppioni.

                    Purtroppo non posso contare in una regola riguardo l’assegnazione dei seriali.

                    Tutto può essere assegnato a chiunque e tutto può anche essere cambiato ovvero, se inizialmente al Cliente1 ho dato gli iPhone X 55-56 potrebbe anche essere che per motivi particolari si decida poi di cambiare dandogli all’ultimo minuto altri seriali sperando che si tratti di seriali mai assegnati a nessuno ed è proprio qui che il controllo doppioni sarebbe una manna dal cielo perchè succede sempre che si compila il file in un certo modo ma poi per esigenze particolari le cose cambiano sempre perchè (ad esempio) la spedizione del Cliente2 è più urgente del Cliente1 e quindi si iniziano a “mischiare le carte” ovvero si inizia ad invertire i seriali tra un Cliente e l’altro ed è qui che poi nascono gli errori.

                    Purtroppo non c’è alcuna regola. Tutto quello che posso fare è controllare i doppioni sia quando finisco di compilare il file e soprattutto di volta in volta che si fanno modifiche e/o spostamenti (quindi sempre).

                    Pensi che con queste condizioni sia possibile trovare un modo?

                    La Macro del file “funzionante” era proprio quello che cercavo (anche se ripete i doppioni 2 volte nel MsgBox non mi interessa) ma purtroppo è funzionale solo se i fogli sono esattamente uguali tra di loro.

                  • sidsid
                    Moderatore
                      Post totali: 752

                      Ciao ad entrambi
                      Prova questa macro; l’ho testata su entrambi i file e “sembra” funzionare.
                      Fai molti test e verifica il corretto funzionamento

                      Sub ELIMINA_DOPPIONI()
                      
                      Dim dict1 As Object, dict2 As Object
                      Dim tbl As ListObject
                      Dim ws As Worksheet
                      Dim j As Long, nk As Long, nRighe As Long, k As Long
                      Dim rSeriale As Range, rFY As Range
                      Dim firstAddress As String, sCodice As String, sProdotto As String, sUnivoco As String, sListaDoppioni As String
                      Dim vArr() As Variant
                      
                      Set dict1 = CreateObject("Scripting.Dictionary")
                      Set dict2 = CreateObject("Scripting.Dictionary")
                      
                      Application.ScreenUpdating = False
                      For Each ws In ThisWorkbook.Worksheets
                          Select Case ws.Name
                              Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData"
                      
                              Case Else
                                  For Each tbl In ws.ListObjects
                                      nRighe = tbl.ListRows.Count
                                      If nRighe >= 2 Then
                                          For nk = 1 To nRighe - 1
                                              If tbl.ListRows(nk).Range.Cells(1, 3) <> vbNullString Then
                                                  sCodice = tbl.ListRows(nk).Range.Cells(1, 3).Value
                                                  sProdotto = tbl.ListRows(nk).Range.Cells(1, 4).Value
                                                  Set rFY = tbl.ListRows(nk).Range.Cells(1, 6).Resize(, 20)
                                                  With rFY
                                                      Set rSeriale = .Find("*", rFY(.Rows.Count, .Columns.Count), xlValues)
                                                      If Not rSeriale Is Nothing Then
                                                          firstAddress = rSeriale.Address
                                                          Do
                                                         ' da qui iniziare il dizionario
                                                              sUnivoco = sCodice & "-" & sProdotto & "-" & rSeriale.Value
                                                              If Not dict1.Exists(sUnivoco) Then
                                                                  dict1(sUnivoco) = sUnivoco & "#" & ws.Name
                                                              Else
                                                                  dict1(sUnivoco) = dict1(sUnivoco) & "-" & ws.Name
                                                                  ReDim Preserve vArr(k)
                                                                  vArr(k) = dict1(sUnivoco)
                                                                  k = k + 1
                                                              End If
                                                          Set rSeriale = .FindNext(rSeriale)
                                                          Loop While Not rSeriale Is Nothing And rSeriale.Address <> firstAddress
                                                      End If
                                                  End With
                                              End If
                                          Next nk
                                      End If
                                  Next tbl
                          End Select
                      Next ws
                      
                      If k > 0 Then
                          For j = UBound(vArr) To LBound(vArr) Step -1
                              sUnivoco = Mid(vArr(j), 1, InStr(1, vArr(j), "#", vbTextCompare))
                              'secondo dizionario
                              If Not dict2.Exists(sUnivoco) Then
                                  sListaDoppioni = sListaDoppioni & vArr(j) & vbLf
                              End If
                          Next j
                              MsgBox sListaDoppioni, vbInformation, "LISTA DOPPIONI"
                      Else
                          MsgBox "Nessun doppione trovato", vbInformation, "LISTA DOPPIONI"
                      End If
                      
                      Application.ScreenUpdating = True
                      Set dict1 = Nothing
                      Set dict2 = Nothing
                      Set rFY = Nothing
                      Set rSeriale = Nothing
                      End Sub

                      (anche se ripete i doppioni 2 volte nel MsgBox non mi interessa)

                      Dovrei aver risolto anche questo passaggio

                    • sidsid
                      Moderatore
                        Post totali: 752

                        Nell’istruzuone
                        Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData"
                        i fogli da escludere , come già ti ho detto nell’altro thread

                      • AvatarKris_9951
                        Partecipante
                          Post totali: 178

                          Grazie mille!!!

                          corro subito a provare!!!

                          Vorrei fare una domanda:

                          è stata prevista la possibilità di escludere alcuni codici dalla ricerca?

                          nel codice di quei due file avevo dettato dei range (Pippo e Pluto) che facevano parte di 2 tabelle che contenevano dei codici da escludere da questo tipo di ricerca, poi subito dopo la macro c’e una UDF che verifica se un certo valore è presente in un determinato range in modo tale che nella Macro può esserci un IF il quale se il valore del campo relativo al codice è diverso dal vuoto E la UDF che cerca se il valore del campo relativo al codice fa parte della lista PIPPO è FALSO E un’altra UDF che cerca se il valore del campo relativo al codice fa parte della lista PLUTO è FALSO Then

                          Controllo doppioni

                           

                          non sapendo leggere bene il codice a prima vista non riesco a capire se questa parte è presente.

                           

                          Ad ogni modo io vi ringrazio infinitamente!

                          Non ancora la provo e stento ancora a crederci che ci sia veramente una soluzione a questo casino!! 😂😉

                        • sidsid
                          Moderatore
                            Post totali: 752

                            è stata prevista la possibilità di escludere alcuni codici dalla ricerca?

                            Come hai visto nel codice c’è l’esclusione di alcuni fogli.
                            I codici da escludere, si possono trovare anche nei fogli in cui si effettua la ricerca?
                            Se i codici di cui parli si trovano nei fogli esclusi, allora non c’è bisogno, altrimenti bisogna fare un lista dei codici da escludere.

                          • AvatarKris_9951
                            Partecipante
                              Post totali: 178

                              Purtroppo io ho tutti i codici (quindi sia quelli da verificare eventuali doppioni e sia quelli da escluderli dalla ricerca di eventuali doppioni) in un unico foglio.

                              Quindi, ho un Foglio che si chiama “CODICI” dove ci sono tutti i codici, sia quelli da includere nella ricerca dei doppioni e sia quelli da escludere e per questo motivo che ho creato delle liste dei codici che devono essere esclusi (es: lista PIPPO e PLUTO) e nella macro ho scritto:

                              ‘ QUI CI SONO DEI RANGE DI CODICI CHE DEVONO ESSERE ESCLUSI DALLA RICERCA DEI DOPPIONI
                              Dim Pippo As Range
                              Dim Pluto As Range
                              Set Pippo = Range(“Tabella19[CODICE]”)
                              Set Pluto = Range(“Tabella20[CODICE]”)
                              ‘_________________________________________

                              e poi nella macro:

                              If ActiveSheet.Cells(x, 3) <> “” And EsisteValore(Pippo, ActiveSheet.Cells(x, 3)) = False And EsisteValore(Pluto, ActiveSheet.Cells(x, 3)) = False Then

                              CONTROLLO DOPPIONI

                              e la UDF:

                              Function EsisteValore(CelleInCuiCercare As Range, ValoreDaCercare As String) As Boolean
                              If Not CelleInCuiCercare.Find(ValoreDaCercare, lookat:=xlWhole) Is Nothing Then
                              EsisteValore = True
                              End If
                              End Function

                              Quindi tra i fogli da escludere c’è il foglio che contiene tutti i codici ed altri fogli che contengono altri dati che non devono essere presi in considerazione nella ricerca dei doppioni.

                               

                              Grazie ancora per tutto il supporto!!! :-)

                            • sidsid
                              Moderatore
                                Post totali: 752

                                Intanto vorrei capire se hai provato la macro, e nel caso con quale risultato.

                                Per quanto riguarda il foglio “CODICI”, possiamo escludelo dalla ricerca, ma possiamo però creare una lista dei codici da escludere, e compararli nell’esecuzione della macro

                              • BySalvBySalv
                                Amministratore del forum
                                  Post totali: 804

                                  Ciao Kriss e Sid, ho provato la macro e funziona bene, da il risultato voluto, ma io affinerei la ricerca al solo codice e non tutti i codici.

                                  Kriss quando deve fare un inserimento credo che già sappia quale seriale assegnare, a questo punto selezionando la quantità da modificare con “Workbook_SheetSelectionChange”, si potrebbero avere 2 opzioni, inserire in una InputBox il seriale ed avere come risposta se è stato assegnato già o meno, visto che selezionando la quantità sappiamo il codice, l’altra opzione, senza sapere il seriale, potrebbe essere la lista di tutti i seriali assegnati per quel codice e quindi controllare se il seriale sia già stato assegnato.

                                  logico questo controllando le liste di esclusione.

                                  Ma se il codice appartiene ad una esclusione anche li viene assegnato un seriale?

                                  Ciao By Sal :bye:

                                  Ciao By Sal (8-)
                                  se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                • AvatarKris_9951
                                  Partecipante
                                    Post totali: 178

                                    Salve a tutti,

                                    ho provato il codice e funziona benissimo!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

                                    :yahoo: :yahoo: :yahoo: :yahoo: :yahoo: :yahoo:

                                    Non ancora vengono esclusi dalla ricerca i codici delle liste PIPPO e PLUTO ma va alla grande!

                                    Purtroppo non ho capito bene la proposta di Sal :wacko:

                                    Forse sono ancora troppo distratto dal fatto che finalmente risolverò il problema :yahoo:

                                  • sidsid
                                    Moderatore
                                      Post totali: 752

                                      Non ancora vengono esclusi dalla ricerca i codici delle liste PIPPO e PLUTO ma va alla grande!

                                      Questa modifica esclude i range PIPPO e PLUTO dalla ricerca.

                                      Devi cambiare la fuction in questo modo

                                      Function EsisteValore(CelleInCuiCercare As Variant, ValoreDaCercare As String) As Boolean
                                      On Error Resume Next
                                      EsisteValore = Application.WorksheetFunction.Match(ValoreDaCercare, CelleInCuiCercare, 0)
                                      On Error GoTo 0
                                      End Function

                                      Questa la macro modificata

                                      Sub ELIMINA_DOPPIONI()
                                      
                                      Dim dict1 As Object, dict2 As Object
                                      Dim tbl As ListObject
                                      Dim ws As Worksheet
                                      Dim j As Long, nk As Long, nRighe As Long, k As Long
                                      Dim rSeriale As Range, rFY As Range
                                      Dim firstAddress As String, sCodice As String, sProdotto As String, sUnivoco As String, sListaDoppioni As String
                                      Dim vArr() As Variant, vRng As Variant, vCod() As Variant, cod As Variant
                                      
                                      Set dict1 = CreateObject("Scripting.Dictionary")
                                      Set dict2 = CreateObject("Scripting.Dictionary")
                                      
                                      vRng = Array([Pippo], [Pluto]) 'array che contiene i range da escludere
                                      
                                      Application.ScreenUpdating = False
                                      
                                      'creo la lista di codici da escludere
                                      For j = LBound(vRng) To UBound(vRng)
                                          For Each cod In vRng(j)
                                              If cod <> vbNullString Then
                                                  ReDim Preserve vCod(k)
                                                  vCod(k) = cod
                                                  k = k + 1
                                              End If
                                          Next cod
                                      Next j
                                      
                                      k = 0
                                      For Each ws In ThisWorkbook.Worksheets
                                          Select Case ws.Name
                                              Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData"
                                      
                                              Case Else
                                                  For Each tbl In ws.ListObjects
                                                      nRighe = tbl.ListRows.Count
                                                      If nRighe >= 2 Then
                                                          For nk = 1 To nRighe - 1
                                                              If tbl.ListRows(nk).Range.Cells(1, 3) <> vbNullString Then
                                                                  sCodice = tbl.ListRows(nk).Range.Cells(1, 3).Value
                                                                  If Not EsisteValore(vCod, sCodice) Then
                                                                      sProdotto = tbl.ListRows(nk).Range.Cells(1, 4).Value
                                                                      Set rFY = tbl.ListRows(nk).Range.Cells(1, 6).Resize(, 20)
                                                                      With rFY
                                                                          Set rSeriale = .Find("*", rFY(.Rows.Count, .Columns.Count), xlValues)
                                                                          If Not rSeriale Is Nothing Then
                                                                              firstAddress = rSeriale.Address
                                                                              Do
                                                                             ' da qui iniziare il dizionario
                                                                                  sUnivoco = sCodice & "-" & sProdotto & "-" & rSeriale.Value
                                                                                  If Not dict1.Exists(sUnivoco) Then
                                                                                      dict1(sUnivoco) = sUnivoco & "#" & ws.Name
                                                                                  Else
                                                                                      dict1(sUnivoco) = dict1(sUnivoco) & "-" & ws.Name
                                                                                      ReDim Preserve vArr(k)
                                                                                      vArr(k) = dict1(sUnivoco)
                                                                                      k = k + 1
                                                                                  End If
                                                                              Set rSeriale = .FindNext(rSeriale)
                                                                              Loop While Not rSeriale Is Nothing And rSeriale.Address <> firstAddress
                                                                          End If
                                                                      End With
                                                                  End If
                                                              End If
                                                          Next nk
                                                      End If
                                                  Next tbl
                                          End Select
                                      Next ws
                                      
                                      If k > 0 Then
                                          For j = UBound(vArr) To LBound(vArr) Step -1
                                              sUnivoco = Mid(vArr(j), 1, InStr(1, vArr(j), "#", vbTextCompare))
                                              'secondo dizionario
                                              If Not dict2.Exists(sUnivoco) Then
                                                  sListaDoppioni = sListaDoppioni & vArr(j) & vbLf
                                              End If
                                          Next j
                                              MsgBox sListaDoppioni, vbInformation, "LISTA DOPPIONI"
                                      Else
                                          MsgBox "Nessun doppione trovato", vbInformation, "LISTA DOPPIONI"
                                      End If
                                      
                                      Application.ScreenUpdating = True
                                      Set dict1 = Nothing
                                      Set dict2 = Nothing
                                      Set rFY = Nothing
                                      Set rSeriale = Nothing
                                      End Sub

                                      Per quanto riguarda l’intervento di BySalv che saluto, appoggio in pieno il suo approccio.
                                      In ogni caso mi sono limitato a lavorare su come è stato pensato il file; certo è che potevano pensarlo meglio ;)

                                    • AvatarKris_9951
                                      Partecipante
                                        Post totali: 178

                                        Grazie è dire poco!!!

                                        Quindi qui devo mettere i nomi delle liste dei codici da escludere, giusto?

                                        vRng = Array([Pippo], [Pluto]) 'array che contiene i range da escludere
                                        
                                        e qui i nomi dei fogli da escludere, giusto?
                                        Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData" (cos'è TempData?   :scratch:  )
                                        
                                        Grazie ancora!!
                                        
                                        P.s. Non ho ancora capito come gestire il TagCode  :-( 
                                      • sidsid
                                        Moderatore
                                          Post totali: 752

                                          Quindi qui devo mettere i nomi delle liste dei codici da escludere, giusto?

                                          Quelle liste sono range, quindi ricordati di metterle tra parentesi quadre.
                                          ======================================================
                                          “TempData” è un foglio nascosto che sta non file “FogliIdenticiFUNZIONA.xlsm”

                                        • BySalvBySalv
                                          Amministratore del forum
                                            Post totali: 804

                                            Ciao ecco la mia soluzione, sempre spartana come al solito, non fa ancora l’esclusione dei codici si deve vedere la lista.

                                            la prima nel modulo “Questa_Cartella_di Lavoro” o “ThisWorkBook”

                                            Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
                                            Dim Cod, dd
                                            If Not Intersect(Target, [E:E]) Is Nothing Then
                                                r = Target.Row
                                                c = Target.Column
                                                If r < 15 Then Exit Sub
                                                Tot = Target
                                                Cod = Cells(r, c - 2)
                                                dd = Cells(r, c - 1)
                                                Call VediDopp1(Cod, dd)
                                            End If
                                            End Sub

                                            la seconda nel modulo standard

                                            Sub VediDopp1(Cod, dd)
                                            Dim r, c, x, y, z, n, d, sh, fg
                                            fg = ActiveSheet.Name
                                            Application.ScreenUpdating = False
                                            For x = 1 To Sheets.Count
                                                sh = Sheets(x).Name
                                                Select Case sh
                                                    Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData"
                                                    Case Else
                                                        Sheets(sh).Select
                                                        For y = 15 To Cells(Rows.Count, 3).End(xlUp).Row
                                                            If Cells(y, 3) = Cod Then
                                                                For z = 6 To 25
                                                                    If Cells(y, z) <> "" Then d = d & Cells(y, z) & ","
                                                                Next z
                                                            End If
                                                        Next y
                                                End Select
                                            Next x
                                            Sheets(fg).Select
                                            Application.ScreenUpdating = True
                                            If d = "" Then
                                                MsgBox "Seriali assegnati al codice " & Cod & "-" & dd & Chr(10) & Chr(10) & "Nessuno", vbInformation, "Lista Seriali assegnati"
                                            Else
                                                MsgBox "Seriali assegnati al codice " & Cod & "-" & dd & Chr(10) & Chr(10) & d, vbInformation, "Lista Seriali assegnati"
                                            End If
                                            End Sub

                                            Vai in un foglio clienti e seleziona la cella sotto “TOT”, non ho ancora previsto di non funzionare con l’intestazione, se vedi doppio numero e perche lo hai già inserito in un altro foglio clienti, potrei anche far comparire in quale foglio è stato inserito il seriale.
                                            ti allego anche il link al file.

                                            http://www.filedropper.com/fogliidenticifunziona

                                            fai sapere, ciao By Sal :Bye:

                                            Ciao By Sal (8-)
                                            se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                          • sidsid
                                            Moderatore
                                              Post totali: 752

                                              Ciao Boss…bell’approccio anche se come hai detto, il lavoro è work in progress.
                                              Se mi permetti, io imposterei il controllo dei fogli da escludere direttamente in Questa cartella di lavoro, sfruttando l’argomento Sh

                                            • sidsid
                                              Moderatore
                                                Post totali: 752

                                                Se mi permetti, io imposterei il controllo dei fogli da escludere direttamente in Questa cartella di lavoro, sfruttando l’argomento Sh

                                                No comment..detto una bojata :(

                                              • AvatarKris_9951
                                                Partecipante
                                                  Post totali: 178

                                                  ====================================================== “TempData” è un foglio nascosto che sta non file “FogliIdenticiFUNZIONA.xlsm”

                                                  possibile che non l’ho visto oppure c’è qualcosa che non me lo fa comparire nell’elenco dei fogli in Visual Basic?

                                                • sidsid
                                                  Moderatore
                                                    Post totali: 752

                                                    possibile che non l’ho visto oppure c’è qualcosa che non me lo fa comparire nell’elenco dei fogli in Visual Basic?

                                                    Perchè è stata impostata la proprietà xlSheetVeryHidden

                                                    Puoi renderlo visibile solo se la imposti in xlSheetVisible
                                                    Se invece lo imposti xlSheetHidden lo puoi vedere nella lista dei fogli da scoprire quando clicchi col il dx sulla linguetta del foglio

                                                  • BySalvBySalv
                                                    Amministratore del forum
                                                      Post totali: 804

                                                      Ciao Kriss, stavo vedendo i codici da escludere, come mai usi 2 Nomi “Pippo-Pluto” alias tabelle “19-20” non puoi usarne una soltanto cosi hai raggruppato in un unica tabella i codici da escludere.

                                                      inoltre hai messo il codice “GGG” e descrizione “RGTE”, so che sono nomi di fantasia, ma se sceglierei come confronto solo il codice escluderei dalla ricerca il Modello nel foglio “Cliente 1” riga 38 codice “GGG” Modello “SANDRA”.

                                                      Come dovrei comportarmi?

                                                      fai sapere Ciao By Sal :bye:

                                                      Ciao By Sal (8-)
                                                      se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                                    • AvatarKris_9951
                                                      Partecipante
                                                        Post totali: 178

                                                        Ciao Sal!

                                                        Ci sono due tabelle per i codici da escludere (ma nel vero file sono anche di più purtroppo) perché quelle tabelle rappresentano una certa categoria di prodotti ben distinti tra di loro i quali giacciono quindi in tabelle diverse.

                                                        Ho anche pensato a creare una nuova tabella che contiene solo i codici da escludere ma poi nel caso nascessero dei nuovi codici dovrei metterli sia nelle loro rispettive tabelle e sia nella tabella che contiene solo i codici da escludere, quindi sono rimasto per lasciare le cose così come sono attribuendo un nome ad ogni lista codice da escludere.

                                                         

                                                        Effettivamente il confronto va fatto solo basandosi sul codice del prodotto e non sul nome del modello in quanto almeno sui codici posso essere sicuro che almeno quelli sono univoci per ogni modello di conseguenza ho sbagliato ad attribuire al codice “GGG” due diversi nomi di fantasia :-(

                                                         

                                                      • BySalvBySalv
                                                        Amministratore del forum
                                                          Post totali: 804

                                                          Ciao Kriss ecco il file, ho modificato le macro in modo che facciano il loro lavoro, questa nel modulo di “Questo_foglio_di_lavoro”

                                                          Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
                                                          Dim Cod, dd
                                                          If Not Intersect(Target, [E:E]) Is Nothing Then
                                                              r = Target.Row
                                                              c = Target.Column
                                                              If r < 15 Then Exit Sub
                                                              Tot = Target
                                                              Cod = Cells(r, c - 2)
                                                              dd = Cells(r, c - 1)
                                                              If Cod = "" Or Cod = "CODICE" Then GoTo 1
                                                              Call VediDopp1(Cod, dd)
                                                          1 End If
                                                          End Sub

                                                          e quest’altra nel modulo3

                                                          Sub VediDopp1(Cod, dd)
                                                          Dim r, c, x, y, z, m, n, d, sh, k, t, fg, Arry
                                                          Arry = Array([Pippo], [Pluto]) 'aggiungere gli altri nomi dei codici esclusi tra parentesi quadre
                                                          fg = ActiveSheet.Name
                                                          Application.ScreenUpdating = False
                                                          For x = 1 To Sheets.Count
                                                              sh = Sheets(x).Name
                                                              Select Case sh
                                                                  Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData"
                                                                  Case Else
                                                                      Sheets(sh).Select
                                                                      For y = 15 To Cells(Rows.Count, 3).End(xlUp).Row
                                                                          For Each n In Arry
                                                                              k = n
                                                                              For m = 1 To UBound(k)
                                                                                  If Cod = k(m, 1) Then t = 1: GoTo 1
                                                                              Next m
                                                                          Next n
                                                                          If Cells(y, 3) = Cod Then
                                                                              For z = 6 To 25
                                                                                  If Cells(y, z) <> "" Then d = d & Cells(y, z) & ","
                                                                              Next z
                                                                          End If
                                                                      Next y
                                                              End Select
                                                          Next x
                                                          1:
                                                          Sheets(fg).Select
                                                          Application.ScreenUpdating = True
                                                          If t = 1 Then
                                                              MsgBox "Codice non incluso nella ricerca", vbInformation, "Lista seriali assegnati"
                                                              Exit Sub
                                                          End If
                                                          If d = "" Then
                                                              MsgBox "Seriali assegnati al codice " & Cod & "-" & dd & Chr(10) & Chr(10) & "Nessuno", vbInformation, "Lista Seriali assegnati"
                                                          
                                                          Else
                                                              MsgBox "Seriali assegnati al codice " & Cod & "-" & dd & Chr(10) & Chr(10) & d, vbInformation, "Lista Seriali assegnati"
                                                          End If
                                                          End Sub

                                                          adesso quando selezioni un codice escluso ti esce il messaggio dell’esclusione dalla ricerca.

                                                          un ultima cosa quando aggiungi una nuova riga per seriali oltre i 20 devi anche inserire ad inizio il codice e modello, altrimenti non viene conteggiata, in quanto non riporta il Codice.

                                                          il link al file, le macro già sono inserite
                                                          http://www.filedropper.com/fogliidenticifunziona_1

                                                          Fai sapere come va, Ciao By Sal :bye:

                                                          Ciao By Sal (8-)
                                                          se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                                        • AvatarKris_9951
                                                          Partecipante
                                                            Post totali: 178

                                                            Mille grazie per il supporto!

                                                            Perdonami ma non capisco cosa fare perchè quando digito “Assegna Macro” al pulsante non mi compare il nome della tua Macro “VediDopp1″…

                                                            Cosa sto sbagliando?

                                                            :scratch:

                                                          • AvatarKris_9951
                                                            Partecipante
                                                              Post totali: 178

                                                              La cosa ironica è che fino a ieri non avevo speranze di risolvere il problema, mentre adesso ho due soluzioni valide e non so quale scegliere!! :yahoo:

                                                            • BySalvBySalv
                                                              Amministratore del forum
                                                                Post totali: 804

                                                                Ciao Kriss, la macro “vedidopp1” è un poco particolare, in quanto è una macro che viene lanciata da un altra macro la quale gli passa dei parametri per la ricerca, cioè gli passa il Codice ed il modello per fare le ricerche su tutti i fogli.

                                                                non deve essere lanciata da un pulsante, quindi oltre che non è visibile nelle macro, non puoi legarla ad un pulsante.

                                                                Viene attivata automaticamente quando selezioni una cella della colonna “E” ecco perche ti dico di selezionare una cella del totale, potevo anche legarla al codice colonna “C”, quindi basta selezionare una cella della colonna “E” e se la riga contiene il codice parte la macro per la ricerca.

                                                                se vuoi posso anche fare in modo che parte quando selezioni un codice nella colonna “C”.

                                                                io odio premere pulsanti, posso sbagliare, quindi dove è possibile cerco di evitare le scelte tramite pulsanti

                                                                per la scelta devi sempre basarti su quella che abbia il miglior risultato che chiedi.

                                                                Fai sapere, Ciao By Sal :bye:

                                                                Ciao By Sal (8-)
                                                                se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                                              • AvatarKris_9951
                                                                Partecipante
                                                                  Post totali: 178

                                                                  Ora ho capito!!!

                                                                  Un MsgBox che ti informa di tutti i seriali che hai assegnato a quel prodotto.

                                                                  Fantastico!! :yahoo:

                                                                  Il problema è che nel file vero le celle della colonna E e quindi quelle relative al totale sono bloccate e non selezionabili…

                                                                  C’è un modo per aggirare il problema?  ;-)

                                                                • AvatarKris_9951
                                                                  Partecipante
                                                                    Post totali: 178

                                                                    Potrei usare sempre la Colonna C (quella dei Codici) ma lì ci vado spesso e far comparire sempre un MsgBox sarebbe fastidioso…

                                                                  • sidsid
                                                                    Moderatore
                                                                      Post totali: 752

                                                                      Usa il doppioclik

                                                                    • AvatarKris_9951
                                                                      Partecipante
                                                                        Post totali: 178

                                                                        Ci ho provato prima ma non funziona :-(

                                                                      • sidsid
                                                                        Moderatore
                                                                          Post totali: 752

                                                                          Devi cambiare l’evento.
                                                                          Ora non ha modo di stare al PC.
                                                                          Spero possa aiutarti bySalv.

                                                                        • AvatarKris_9951
                                                                          Partecipante
                                                                            Post totali: 178

                                                                            Potrebbe andare così secondo voi?

                                                                            Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
                                                                            Dim Cod, dd
                                                                            If Not Intersect(Target, [C:C]) Is Nothing Then
                                                                            r = Target.Row
                                                                            c = Target.Column
                                                                            If r < 15 Then Exit Sub
                                                                            Tot = Target
                                                                            Cod = Cells(r, c)
                                                                            dd = Cells(r, c + 1)
                                                                            If Cod = “” Or Cod = “CODICE” Then GoTo 1
                                                                            Call VediDopp1(Cod, dd)
                                                                            1 End If

                                                                            End Sub

                                                                            Doppio Click sulla colonna C

                                                                            Poi alla fine della Macro VediDopp1 ho scritto:

                                                                            ActiveCell.Offset(0, 3).Select

                                                                            Altrimenti la cella rimaneva con il testo selezionato…

                                                                          • AvatarKris_9951
                                                                            Partecipante
                                                                              Post totali: 178

                                                                              Ragazzi ad ogni modo grazie infinite!!!

                                                                              Grazie di tutto!! :yahoo: :heart:

                                                                            • sidsid
                                                                              Moderatore
                                                                                Post totali: 752

                                                                                Per evitare che resti il cursore che lampeggia nella cella, nell’evento doppioclick prima di
                                                                                End Sub
                                                                                ci devi mettere l’istruzione
                                                                                Cancel = True

                                                                              • BySalvBySalv
                                                                                Amministratore del forum
                                                                                  Post totali: 804

                                                                                  Ciao Ho visto che hai risolto, dopo l’ultima risposta ho avuto ospiti, bravo avrei fatto la stessa cosa al codice, ed anche il consiglio di Sid del “DoppioClick” non sapevo che la colonna E era bloccata.

                                                                                  avevo scelto la colonna “E”, per come avevo detto al principio, se i seriali erano progressivi si potevano inserire in automatico, ed anche creare la nuova riga superando i 20 seriali nella riga.

                                                                                  a questo punto puoi eliminare nella prima macro la riga

                                                                                  Tot = Target

                                                                                  che serviva appunto a fare il calcolo dei seriali da aggiungere.

                                                                                  Ciao By Sal :bye:

                                                                                  Ciao By Sal (8-)
                                                                                  se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                                                                • AvatarKris_9951
                                                                                  Partecipante
                                                                                    Post totali: 178

                                                                                    Ok, continuo ad approfittare della Vostra gentilezza 😬

                                                                                    Una InputBox che contiene sia la lista di tutti i seriali assegnati a quel prodotto (quindi come quella che hai fatto) e che contiene anche due campi “DA” “A”, in modo tale che nel caso in cui i seriali siano tutti consecutivi potrei usufruire dell’automazione VBA?

                                                                                    Sarebbe possibile? 😅😬

                                                                                  • AvatarKris_9951
                                                                                    Partecipante
                                                                                      Post totali: 178

                                                                                      Ripensandoci, a questo punto è venuta in mente un’altra idea molto utile ma per correttezza devo fare da solo perché ho approfittato fin troppo della Vostra gentilezza.

                                                                                      Sicuramente vi chiederò aiuto perché prima o poi mi bloccherò quindi vi espongo la mia idea per vedere quantomeno se è fattibile.

                                                                                      Sul doppio Click della colonna “C” del codice che mi interessa sarebbe utile che si aprisse una UserForm che contiene 3 cose:

                                                                                      1 – la situazione di tutti i seriali inseriti per quell’apparato (come già stato fatto da Sal)

                                                                                      2 – 2 checkbox con due etichette (una per ogni checkbox)

                                                                                      La prima etichetta si chiama “Inserisci quantità ordinata” ed a fianco una TextBox la quale può accettare solo numeri

                                                                                      La seconda etichetta collegata alla seconda checkbox si chiama “Inserisci range seriali” ed a fianco due textbox “DA” “A” ed anch’esse possono accettare solo numeri

                                                                                      La regola per queste due checkbox è che posso usare solo una delle due checkbox e non entrambe, quindi se seleziono una l’altra deve disattivarsi insieme alla sua Textbox.

                                                                                      Quindi se seleziono la CheckBox “Inserisci quantità” l’altra CheckBox con le sue relative TextBox devono disattivarsi (tipo in “grigetto”)

                                                                                       

                                                                                      Alla textbox di “Inserisci quantità ordinata” posso mettere un numero ed una volta confermato la macro deve solo colorare di GIALLO un numero di celle pari al numero inserito, quindi se scrivo “10” deve colorare di giallo le prime 10 celle dei seriali di quel codice ma il contenuto delle celle rimane invariato

                                                                                       

                                                                                      La TextBox Inserisci quantità deve fare la stessa cosa ma con i numeri seriali disposti in modo progressivo.

                                                                                      Il concetto è che solitamente io colo prima le celle in modo da capire quanto prodotti ha ordinato al fine di organizzarmi ed una volta che sono a conoscenza dei seriali da assegnare posso inserire anche i seriali nelle celle colorare di giallo (infatti nella colonna E c’è una formula che conta in base al colore della cella)

                                                                                       

                                                                                      Secondo voi è fattibile?

                                                                                    • BySalvBySalv
                                                                                      Amministratore del forum
                                                                                        Post totali: 804

                                                                                        Ciao Kriss, come ho specificato nelle prime risposte, quasi niente è impossibile con il VBA, l’importante è avere bene in mente cosa si vuole fare ed il risultato da ottenere.

                                                                                        Se hai difficoltà siamo qui

                                                                                        Ciao By Sal (8-D

                                                                                        Ciao By Sal (8-)
                                                                                        se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

                                                                                      • AvatarKris_9951
                                                                                        Partecipante
                                                                                          Post totali: 178

                                                                                          Ok. Io creo la UserForm con tutte le caratteristiche che voglio.

                                                                                          Vi ringrazio ancora per il supporto 😊

                                                                                          Mi farò vivo di nuovo al 100% 😭

                                                                                          A presto!! 👍

                                                                                        • AvatarKris_9951
                                                                                          Partecipante
                                                                                            Post totali: 178

                                                                                            Salve ragazzi,

                                                                                            io ho iniziato a produrre la ia idea ma, ovviamente, mi sono bloccato perchè il mio livello è quello che è :-(

                                                                                             

                                                                                            Descrivo quello che ho fatto nella speranza che possiate aiutarmi :-)

                                                                                            Sul doppio Click della colonna “C” del codice che mi interessa si apre una UserForm che contiene 3 cose:

                                                                                            1 – una TextBox la quale vorrei contenesse la situazione di tutti i seriali inseriti per quell’apparato (come già stato fatto da Sal), ovvero la macro VediDopp1

                                                                                            2 – 2 checkbox con due etichette (una per ogni checkbox)

                                                                                            La prima etichetta si chiama “PRENOTA” ed a fianco una TextBox la quale può accettare solo numeri

                                                                                            La seconda etichetta collegata alla seconda checkbox si chiama “ASSEGNA” ed a fianco due textbox “DA” “A” ed anch’esse possono accettare solo numeri

                                                                                             

                                                                                            Alla textbox di “PRENOTA” posso mettere un numero ed una volta confermato con il pulsante OK la macro deve solo colorare di GIALLO un numero di celle pari al numero inserito, quindi se scrivo “10” deve colorare di giallo le prime 10 celle dei seriali di quel codice ma il contenuto delle celle rimane invariato.

                                                                                            Sarebbe “figo” se potesse inserire anche una riga nuova nel caso viene inserito un numero superiore a 20 ed un altra ancora per numeri superiori a 40 e così via ;-)

                                                                                             

                                                                                            La TextBox ASSEGNA deve fare la stessa cosa ma con anche  i numeri seriali disposti in modo progressivo.

                                                                                            Il concetto è che solitamente io coloro prima le celle in modo da capire quanto prodotti ha ordinato al fine di organizzarmi ed una volta che sono a conoscenza dei seriali da assegnare posso inserire anche i seriali nelle celle colorare di giallo (infatti nella colonna E c’è una formula che conta in base al colore della cella).

                                                                                            Spero in un Vostro aiuto perchè io non sono ad un livello tale da poterci riuscire da solo :-(

                                                                                             

                                                                                            Grazie a tutti per l’aiuto!!

                                                                                            https://www.dropbox.com/s/0e3x8be67ue9uf1/BYSAL.xlsm?dl=0

                                                                                          • sidsid
                                                                                            Moderatore
                                                                                              Post totali: 752

                                                                                              Questo thread sta diventando troppo dispersivo, con argomenti che si accavallano in continuo.
                                                                                              Sarebbe il caso di aprire un thread per ogni argomento richiesto.
                                                                                              Grazie della collaborazione.

                                                                                            • AvatarKris_9951
                                                                                              Partecipante
                                                                                                Post totali: 178

                                                                                                Grazie a Voi!! 😊

                                                                                              • sidsid
                                                                                                Moderatore
                                                                                                  Post totali: 752

                                                                                                  Ho visto il tuo file.
                                                                                                  Mi permetto un consiglio: al posto delle checkbox usa le OptionButton; sono più adatte alla tua esigenza perchè non devi preoccuparti di escludere il flag dagli altri controlli; con le OB il flag nel controllo attivo, esclude il flag in tutti gli altri (tranne in casi particolari, ma questo non è il tuo)

                                                                                              Visualizzazione 45 filoni di risposte
                                                                                              • Devi essere connesso per rispondere a questo topic.