Dividere stringhe in ogni colonna

[ikwae]

Ciao a tutti … Ho delle stringhe in colonna B e le devo dividere ognuna nella propria colonna.
So come trovare la prima “presa” di ogni stringa. So come destinarle alla propria colonna ma non sono capace
di selezionare tutte le stringhe della stessa “specie” per spostarle nelle colonne assegnate.
Ho già delle macro “casarecce” veloci, precise e ordinate che svolgono bene il tutto ma se manca una sola stringa vanno in errore e bloccano il ciclo.
Io di volta in volta inserisco un dato fittizio (alla fine del ciclo lo tolgo) solo per completare il ciclo. Assicuro che non è molto pratico.
Le macro hanno una struttura fuori da ogni ragionamento pratico sono talmente incasinate e contorte, che preferisco
non postare ma se richieste le allego volentieri. Sono sicuro che fanno perdere solo tempo per poterle mettere a posto.
Chiedo aiuto a tutto il Forum per avere una macro, che scorra tutta la colonna B trova le stringhe (CA, Fi… RN) e li sposta nelle colonne di destinazione.
In allegato un file con due fogli:
uno 5ne che dà indicazioni dettagliate sulle operazioni che la macro di aiuto deve fare.
uno 5ne_Fine solo come indicazione. La macro di aiuto deve lavorare solo sul foglio 5ne.
Ringraziando anticipatamente tutti coloro che mi possono aiutare. 73 ikwae
http://www.filedropper.com/7cinquinerete

[Anthony47]

FI_ stringa mancante( La D rimane vuota)

Purtroppo non riesco a farmi una idea precisa di che cosa significa questa istruzione.
Stai dicendo che se non ci sono celle che cominciano per FI la colonna destinata a FI (col. D) dovra' (ovviamente) risultare vuota, o che se ci sono celle che contengono solo "FI_" allora la cella va ignorata? O...?

Ciao

[ikwae]

Gentilissimo Anthony gentile come sempre a rispondermi... si le stringhe sono complete tipo questa
FI_Gr2_C-01 - 015 tern (20) Bari quindi giusto la colonna D rimane vuota ...
anche la stringa NA_Gr2_C-01 - 015 tern (20) Palermo è da considerarsi completa e di conseguenza
la colonna abbinata rimarrà vuota. Li ho abbreviate per comodità di scrittura.
Grazie per adesso

[Anthony47]

Purtroppo le "precisazioni" mi confondono vieppiu' (sembra dicano l'opposto di quanto c'era scritto nel primo messaggio).

Facciamo che ti propongo questa macro:

Codice: Seleziona tutto

Sub mahhh()
Dim oArr(), LastR As Long, MaxO As Long, nInd As Long
Dim WArr, I As Long, myMatch, Heads
'
Sheets("5ne").Select
LastR = Cells(Rows.Count, "B").End(xlUp).Row
WArr = Range(Cells(2, 2), Cells(LastR, 2)).Value
Heads = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
ReDim oArr(1 To 12, 1 To 1)
For I = 1 To UBound(WArr)
    If Len(WArr(I, 1)) > 6 Then
        myMatch = Application.Match(Left(WArr(I, 1), 2), Heads, False)
        If IsError(myMatch) Then myMatch = 12
        nInd = oArr(myMatch, 1) + 1
        If nInd > MaxO Then
            ReDim Preserve oArr(1 To 12, 1 To nInd + 1)
            MaxO = nInd
        End If
        oArr(myMatch, nInd + 1) = WArr(I, 1)
        oArr(myMatch, 1) = nInd
    End If
Next I
Sheets("5ne_Fine").Range("B1").Resize(UBound(oArr, 2), UBound(oArr)).Value = Application.WorksheetFunction.Transpose(oArr)
Sheets("5ne_Fine").Range("B1").Resize(1, 12).Value = Heads
End Sub


Mettila in un modulo standard del vba e poi eseguila;
Nel foglio 5ne_fine scrivera' delle cose in colonna B:L, mentre in colonna M scrivera' le cose che non e' riuscita a piazzare.

Se non fa quel che cerchi allora pubblica un file esemplificativo, e spiega che cosa non ha "piazzato" male e dove quelle cose avrebbero dovuto stare e perche'

Ciao

[ikwae]

La macro funziona bene e anche molta astuta l’idea di scrivere il superfluo in colonna M.
Purtroppo deve operare all’interno di un ciclo che ha già una sua struttura quindi se possibile fare dei “ritocchi”.
1) che non scriva nella prima riga e neanche in colonna M
2) e soprattutto, se è possibile, che scriva direttamente sul foglio “5ne” come da richiesta.
Cordialmente ikwae

[Anthony47]

Ma se i nuovi dati sovrascrivono quelli di partenza, come farai a controllare se e' andato tutto bene?

Comunque...

Codice: Seleziona tutto

Sub mahhh2()
Dim oArr(), LastR As Long, MaxO As Long, nInd As Long
Dim WArr, I As Long, myMatch, Heads
Dim AInd(1 To 12)
'
Sheets("5ne").Select
LastR = Cells(Rows.Count, "B").End(xlUp).Row
WArr = Range(Cells(2, 2), Cells(LastR, 2)).Value
Heads = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
ReDim oArr(1 To 12, 1 To 1)
For I = 1 To UBound(WArr)
    If Len(WArr(I, 1)) > 6 Then
        myMatch = Application.Match(Left(WArr(I, 1), 2), Heads, False)
        If IsError(myMatch) Then myMatch = 12
        nInd = AInd(myMatch) + 1
        If nInd > MaxO Then
            ReDim Preserve oArr(1 To 12, 1 To nInd + 1)
            MaxO = nInd
        End If
        oArr(myMatch, nInd) = WArr(I, 1)
        AInd(myMatch) = nInd
    End If
Next I
Sheets("5ne").Range("B2").Resize(LastR, 11).ClearContents
Sheets("5ne").Range("N1").Resize(LastR, 1).ClearContents
'Scrive i risultati:
Sheets("5ne").Range("B2").Resize(UBound(oArr, 2), 11).Value = Application.WorksheetFunction.Transpose(oArr)
'Scrive le righe non "piazzate":
Sheets("5ne").Range("N2").Resize(UBound(oArr, 2), 1).Value = Application.WorksheetFunction.Index(Application.WorksheetFunction.Transpose(oArr), 0, 12)
End Sub


Questa scrive i risultati sui dati di partenza, cominciando da B2:L2; scrive "gli avanzi" in colonna N

Ciao

[ikwae]

Gentilissimo Anthony la macro funziona bene anzi benissimo. Ho tolto dal foglio “5ne” le scritte in rosso quindi o la stringa c’è oppure è mancante quindi non c’è. Vorrei eliminare dal codice la parte inerente (scrive "gli avanzi" in colonna N) (non per cattiveria o che non sia utile) perché il ciclo non prevede questa indicazione e anche perché mi dà la possibilità che con meno righe di codice riesco a comprendere meglio e di conseguenza a modificarlo per far delle altre prese (tipo gruppi o cinquine). E’ da stamattina che ci provo ma con scarsi risultati. Anche se riesco in qualche modo a capirla mi confonde questo rigo di codice If Len(WArr(I, 1)) > 6 Then .
Quindi ci rinuncio a tentare di modificarla, la userò come l’hai fatta (fino a che non riesco a decifrare tutto il codice). Dato che è un ciclo completo e qualche volta può essere necessario modificare ad esempio inserendo una colonna o altre aggiustatine e se non sono capace di fare le modifiche o aggiornamenti sono sempre a chiedere cose che poi non riesco a gestire quindi ti chiedo se mi puoi spiegare come si possono solo selezionare tutte le stringhe omogenee presenti in colonna B. Faccio un esempio se mando in esecuzione la macro che cerca la stringa FI (FI_Gr2_C-13 - 130 tern (20) Torino) e la trova quindi sono sulla cella attiva come posso fare a selezionare se ci sono altre stringhe sotto della ruota di FI?. Se c’è una sola stringa deve selezionare solo una cella, se ci sono due stringhe deve selezionare solo due celle se ci sono tre stringhe deve selezionare solo tre celle, se ci sono tot stringhe deve selezionare tot celle. Spero di essermi spiegato. So che all’interno della tua macro c’è questa indicazione ma non riesco a “estrarla” (almeno per adesso) da usare separatamente.
******************************

Ma se i nuovi dati sovrascrivono quelli di partenza, come farai a controllare se e' andato tutto bene?

Il ciclo comprende una SuperMacroVigile che gestisce una quarantina di macro (e anche oltre) e una decina di fogli
che prima li crea e poi se i conteggi sono giusti li cancella tutti e lo fa in completa autonomia. A fine ciclo rimangono solo due fogli uno di nome “Accodati” dove ci sono le stringhe originali e un foglio di nome “Somme” che riepiloga ogni parte delle stringhe (gruppi, ruote, cinquine con relative quantità) quindi non è necessario sapere cosa fa una macro perché nel riepilogo del foglio “Somme” c’è tutto, in modo dettagliatissimo, quello che necessita sapere. I conteggi sono sempre stati esatti comunque nel dubbio si possono controllare confrontando le stringhe originali. Ho controllato le prime volte dopo aver fatto il ciclo e sono state sempre precise. Con la nuova macro di aiuto che hai fatto, farò qualche controllo con le stringhe originali ma sono sicuro che saranno giusti.
Ringraziandoti mille e mille volte per il tuo aiuto e disponibilità. Cordialmente ikwae

[ikwae]

Gentilissimo Anthony … la tua macro sono riuscito a capirla e di conseguenza l’ho modificata per le cinquine (BA_Gr2_C-01 - 015 tern (20) Nazionale) dalla C-01 fino alla C-18. Nelle prove ho scoperto che non necessariamente devono essere in ordine progressivo ma possono anche essere in qualunque ordine e mandando in esecuzione la macro trova le stringhe dove esse siano e le incolla nella giusta colonna … Complimenti per la tua ottima macro… Aggiungo che è sempre valida la richiesta di aiuto scritta nel post sopra ossia di selezione della/e stringhe… Allego la macro modificata a beneficio di chi la vuole usare.
Ringraziandoti ancora mille e mille volte per il tuo aiuto e disponibilità. Cordialmente ikwae

Codice: Seleziona tutto

Sub mahhh2_Recupero5ne()
Dim oArr(), LastR As Long, MaxO As Long, nInd As Long
Dim WArr, I As Long, myMatch, Heads
'Dim AInd(1 To 12)'ORG
 Dim AInd(1 To 18) 'OK FUNGE
'
Sheets("5ne").Select
LastR = Cells(Rows.Count, "B").End(xlUp).Row
WArr = Range(Cells(2, 2), Cells(LastR, 2)).Value

'Heads = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
 Heads = Array("C-01", "C-02", "C-03", "C-04", "C-05", "C-06", "C-07", "C-08", "C-09", "C-10", "C-11", "C-12", "C-13", "C-14", "C-15", "C-16", "C-17", "C-18")

'ReDim oArr(1 To 12, 1 To 1) 'ORG
 ReDim oArr(1 To 18, 1 To 1) 'OK FUNGE

For I = 1 To UBound(WArr)
     If Len(WArr(I, 1)) > 6 Then
       
  'myMatch = Application.Match(Left(WArr(I, 1), 2), Heads, False)'ORG
   myMatch = Application.Match(Mid(WArr(I, 1), 8, 4), Heads, False) 'OK FUNGE
         
       'If IsError(myMatch) Then myMatch = 12
        If IsError(myMatch) Then myMatch = 18 'OK FUNGE
         
        nInd = AInd(myMatch) + 1
        If nInd > MaxO Then
           
            'ReDim Preserve oArr(1 To 12, 1 To nInd + 1) 'ORG
             ReDim Preserve oArr(1 To 18, 1 To nInd + 1) 'OK FUNGE
                     
            MaxO = nInd
        End If
        oArr(myMatch, nInd) = WArr(I, 1)
        AInd(myMatch) = nInd
    End If
Next I
'Sheets("5ne").Range("B2").Resize(LastR, 11).ClearContents 'ORG
 Sheets("5ne").Range("B2").Resize(LastR, 18).ClearContents 'OK FUNGE

 Sheets("5ne").Range("N1").Resize(LastR, 1).ClearContents
'Scrive i risultati:
'Sheets("5ne").Range("B2").Resize(UBound(oArr, 2), 11).Value = Application.WorksheetFunction.Transpose(oArr) 'ORG
 Sheets("5ne").Range("B2").Resize(UBound(oArr, 2), 18).Value = Application.WorksheetFunction.Transpose(oArr) 'OK FUNGE
 
'Scrive le righe non "piazzate":
'wae non usato
'Sheets("5ne").Range("N2").Resize(UBound(oArr, 2), 1).Value = Application.WorksheetFunction.Index(Application.WorksheetFunction.Transpose(oArr), 0, 12)
End Sub

[Anthony47]

Beh, avevo preparato una risposta ma ora e' in gran parte superata dal tuo messaggio.

ECCOLA LO STESSO, magari c'e' qualche informazione teorica in piu' e una informazione circa la "selezione" di stringhe omogenee.

Ti ripropongo la macro con ricchi commenti

Codice: Seleziona tutto

Sub mahhh2()
Dim oArr(), LastR As Long, MaxO As Long, nInd As Long
Dim WArr, I As Long, myMatch, Heads
Dim AInd(1 To 12)                       'Contiene il puntatore delle 12 colonne di OArr
'
Sheets("5ne").Select
LastR = Cells(Rows.Count, "B").End(xlUp).Row
'Mette in memoria il contenuto di colonna B:
WArr = Range(Cells(2, 2), Cells(LastR, 2)).Value
'L'elenco posizionale delle ruote:
Heads = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
'dimensiona oArr: 12 colonn2 (11 ruote + avanzi), numero righe a crescere:
ReDim oArr(1 To 12, 1 To 1)
'Ciclo di scansione della matrice WARR:
For I = 1 To UBound(WArr)
    'Controlla la lunghezza della stringa: min 7 crt
    If Len(WArr(I, 1)) > 6 Then
        'Analizza le prime 2 lettere e determina la posizione della stringa corrente:
        myMatch = Application.Match(Left(WArr(I, 1), 2), Heads, False)      'come funzione Confronta di Excel
        If IsError(myMatch) Then myMatch = 12                               'Se non l'ha trovata, va tra gli "avanzi"
        nInd = AInd(myMatch) + 1                                            'calcola nuovo Indice
        If nInd > MaxO Then                                                 'MaxO contiene la dimensione attuale do OArr
            ReDim Preserve oArr(1 To 12, 1 To nInd + 1)                     '..se serve "allunga OArr
            MaxO = nInd                                                     '...a aggiorna il nuovo MaxO
        End If
        oArr(myMatch, nInd) = WArr(I, 1)                                    'Mette la stringa corrente in OArr, colonna myMatch
        AInd(myMatch) = nInd                                                'Aggiorna l'indice di quella colonna
    End If
Next I
'Pulisce B2:Lxx
Sheets("5ne").Range("B2").Resize(LastR, 11).ClearContents
'Pulisce colonna N:
Sheets("5ne").Range("N1").Resize(LastR, 1).ClearContents
'Scrive oArr in B2:Lyy
Sheets("5ne").Range("B2").Resize(UBound(oArr, 2), 11).Value = Application.WorksheetFunction.Transpose(oArr)
'Estrae colonna 12 e la scrive in colonna N:
Sheets("5ne").Range("N2").Resize(UBound(oArr, 2), 1).Value = Application.WorksheetFunction.Index(Application.WorksheetFunction.Transpose(oArr), 0, 12)
End Sub


Non sapendo come sono organizzati e strutturati i tuoi dati la macro esamina una cella alla volta e ne posiziona il contenuto nella colonna 1-11 della matrice oArr in cui creo l'output; la colonna e' determinata tramite un Confronta dell'inizio della cella con l'array HEADS; se la posizione e' indeterminabile quel contenuto va in colonna 12 della matrice oArr
Non conoscendo quante righe max saranno presenti in oArr, la dimensione viene "allungata" all'occorrenza tramire Redim+Preserve

Alla fine scarico in B:L il contenuto delle prime 11 colonne di oArr; poi estraggo la colonna 12 (tramite la funzione Indice di Excel) e la scarico in colonna N

Ti sara' quindi facile eliminare la singola istruzione che scrive gli "avanzi" in colonna N (eliminarli anche da oArr sarebbe una complicazione inutile)

Come detto nei commenti, l'istruzione If Len(WArr(I, 1)) > 6 Then serve a filtrare le stringhe per una lunghezza minima: visto che non sono riuscito a decodificare la richiesta "Se Stringa mancante la colonna rimane vuota" almeno ignoro le celle che contengono pochi crt (anche se non so se puo' succedere).

Io non so nemmeno se il tuo elenco e' gia' ordinato, cosa che potrebbe suggerire un procedimento diverso, ma non piu' ottimizzato; pertanto la macro procede a sistemare una cella per volta.

La macro si guarda bene dal selezionare le celle, ne' una per una ne' per "stringhe omogenee" (interpretazione mia: che hanno in testa la stessa sigla di ruota). Con 40 celle non sarebbe un problema, ma con 100mila cominceresti ad aspettare 10 minuti.
Siccome pero' questa suddivisione "per stringhe omogenee" esiste nella matrice oArr la puoi estrarre o "puntare" all'occorrenza.

Bisogna pero' tenere presente che in oArr i dati non sono di 12 colonne*N righe, ma di 12 righe*N colonne (perche' Redim Preserve consente di allungare solo "l'ultima" dimensione"
Troverai quindi le info di BA in riga 1, colonna1, colonna2, colonna3,...; quelle di CA in riga 2, colonna1, colonna 2, colonna...; etc

Se vuoi scriverle in una certa posizione puoi fare come faccio con la colonna 12 (gli avanzi) che scrivevo in colonna N; es se vuoi scrivere in B2:Bxx di Foglio1 i risultati di GE, userai

Codice: Seleziona tutto

Sheets("Foglio1").Range("B2").Resize(UBound(oArr, 2), 1).Value = Application.WorksheetFunction.Index(Application.WorksheetFunction.Transpose(oArr), 0, 4)   '4 e' la colonna di GE


Spero ci siano le informazioni che aspettavi...

Ciao

[ikwae]

Le info del tuo ultimo post sono molto preziose. Purtroppo sono "lento" a capire mi necessita tempo prima di poterlo smanettare nella sua interezza. Comunque sarà mia premura cercare di utilizzare la macro per altri lavori... Inutile chiederti una semplice macro che scorra le colonna B e seleziona una o più stringhe omogenee (solo ad uso didattico). Se dopo aver letto le tue preziose e interessantissime info e mi servono altre indicazioni ti interpellerò senz'altro. Ringraziandoti mille e mille volte per il tuo prezioso aiuto e la tua disponibilità. Cordialmente ikwae

[Anthony47]

Inutile chiederti una semplice macro che scorra le colonna B e seleziona una o più stringhe omogenee (solo ad uso didattico)

Ad esempio:

Codice: Seleziona tutto

Sub DemoSel()
Dim Selector As String, lFor As String
'
lFor = "_gr2_c-18"            '<<< La stringa "Chiave" da cercare
For I = 2 To Cells(Rows.Count, "B").End(xlUp).Row
    If InStr(1, Cells(I, "B").Value, lFor, vbTextCompare) > 0 Then
        Selector = Selector & "," & Cells(I, "B").Address
    End If
Next I
Range(Mid(Selector, 2)).Select
End Sub


La macro selezionera' nell'elenco di colonna B tutte le celle che al loro interno contengono la stringa "_gr2_c-18", ignorando maiusc/minusc

Ovviamente se l'elenco fosse sempre ordinato si potrebbe utilizzare un algoritmo piu' performante, ma visto che ti inseressa non solo guardare in testa ma anche in mezzo alle scritte sono andato per una cosa piu' terra-terra.

Ciao

[ikwae]

Gentilissimo Anthony … e non aggiungo altro. Con certezza ti posso dire che questa tua ultima macro è la più utile di tutti gli aiuti precedenti che ho avuto da “utente affezionato”. Mi spiego, le macro di aiuto sono fine a sé stesse fanno un solo lavoro, molto utile e apprezzato. Ma questa macro è uno attrezzo “universale” (almeno per me) e ti spiego quando si inizia a “programmare” ossia scrivere codice dell’idea che ho in testa e la voglio concretizzare. Si parte sempre da cose semplici copia e incolla, aggiungi, seleziona, sposta, “taglia e cuci” e altre cosette del genere tipo 1à elementare e poi, dopo milioni di prove, si inizia a dare “forma” e struttura alla macro e una volta finita si chiede aiuto per dare struttura(professionale) oppure velocità.
Ricordandoti il mio motto “usa quello che hai, se lo capisci e soprattutto, se lo sai applicare” ….
Ringraziandoti ancora con mille e mille grazie. Cordialmente ikwae