Modificare_Macro Per_Dati_In_Colonne_Separate

[ikwae]

Ciao a tutti … Ho accorpato tre macro in una e funziona bene ma non riesco a far scrivere le stringhe
in colonne diverse. Le stringhe vengono accodate, erroneamente, tutte in colonna B del foglio “Freque”.
Ho usato vari modi per poter superare l’ostacolo ma non ci sono riuscito c’è il [Next p], che copre
l’intera area della macro, impedendomi di applicare un contatore per le colonne.
Quindi chiedo aiuto a tutto il Forum per modificare la mia macro per scrivere le stringhe in colonne
diverse come riportato sul foglio “Freque-Fine”. Se non si riesce a modificare la mia macro e si deve
scrivere una nuova macro, che scriva le stringhe in colonne diverse, spiego brevemente le fasi della macro:
1a) la prima parte scansiona tutta la tabella “TabRuSu” per cercare un dato e, trovato il dato, lo seleziona.
2b) selezionato il dato parte la seconda parte della macro e dalla cella attiva “riempie” tre di quattro
celle (una è riempita in automatico).
3c) riempite le celle interviene la terza parte della macro che confronta tutte le stringhe del foglio
“Ordinati” con le “chiavi” delle 4 celle e la stringa che contiene contemporaneamente le 4 “chiavi”
viene incollata sul foglio “Freque”.
Ricapitolando chiedo che venga modificata solo la terza parte della mia macro (3c). In alternativa se
non si riesce a interpretare la mia macro la posso descrivere dettagliatamente se necessario.
In allegato 4 fogli;
1a) foglio “Ordinati” dove ci sono copie delle stringhe originali.
2b) foglio “Freque” dove si devono incollare le stringhe confrontate e conformi alle “chiavi” di ricerca.
3c) foglio “Freque-Fine” che è quello che si desidera come prodotto finale ossia in colonne separate.
4d) foglio “TabRuSu” che è l’area della tabella dove cercare il/i dato/i. Aggiungo che sul questo foglio
c’è la solita bandierina che cliccata fa la scansione per trovare il dato [If p.Value >= 6 Then Else GoTo 10]
e sul foglio “Freque” c’è il risultato (errato) dovrebbero essere su colonne diverse come mostrato sul foglio “Freque-Fine”.
Ringraziando anticipatamente tutti coloro che mi possono aiutare 73 ikwae

http://www.filedropper.com/a7tab18divid ... paraterete

[Anthony47]

Ho modificato la tua macro in questo modo:
Ho aggiunto questa istruzione in questa posizione:

Codice: Seleziona tutto

ColDest = 2         '<< QUESTA
Application.ScreenUpdating = False

Ho sostituito il blocco

Codice: Seleziona tutto

''    Sheets("Freque").Select
''    Dim bRow As Integer
''    bRow = 2 'riga 2
''    While Cells(bRow, 2).Value <> "" 'Colonna 2 è la B
''        bRow = bRow + 1
''    Wend
''    Cells(bRow, 2).Select 'Tutto In Colonna B
''    ActiveSheet.Paste

CON:

Codice: Seleziona tutto

With Sheets("Freque_fine")
GetLU:
    lastdest = .Cells(Rows.Count, ColDest).End(xlUp).Row
    If Right("            " & .Cells(lastdest, ColDest).Value, Len(Sheets("TabRuSu").Range("AP39").Value)) <> Sheets("TabRuSu").Range("AP39").Value And lastdest > 1 Then
        ColDest = ColDest + 1
        relast = True
    Else
        relast = False
    End If
    If relast Then GoTo GetLU
    .Cells(lastdest + 1, ColDest).Value = CL.Value
End With


A occhio mi pare che funzioni, ma il collaudo tocca a te

Ciao

[ikwae]

Gentilissimo Anthony sempre gentile a rispondermi… ho aggiunto le tue modifiche alla mia macro e tutto sembra ok
ma i conti non tornano! Mi spiego meglio ho fatto una ricerca [If p.Value >= 4 Then Else GoTo 10] con valore >= 4
e ha completato scrivendo i dai in colonne separate. I valori con >=4 sono 108 e le colonne riempite sono 102 quindi
ne mancano 6. Ho controllato una a una le colonne e mi sono accorto che in sei colonne ci sono dei dati, destinati alla
colonna successiva, in coda sulla stessa colonna… le anomalie;
1a) la colonna N, del foglio “Freque-Fine”, vedrai che hanno stringe diverse, 4 sono della ruota di BA e altre 4 sono
della ruota di CA hanno in comune solo la parola Nazionale.
2b) In colonna R qui sono identiche ma hanno solo la cinquina diversa 4 hanno la C-08 mentre 5 hanno la C-09
3c) In colonna U qui sono identiche ma hanno solo la cinquina diversa 6 hanno la C-05 mentre 4 hanno la C-08
4d) In colonna AO come la colonna N ha in comune la parola Torino.
5e) In colonna BA qui sono identiche ma hanno solo la cinquina diversa 4 hanno la C-14 mentre 4 hanno la C-17
6f) In colonna BQ qui sono identiche ma hanno solo la cinquina diversa 4 hanno la C-09 mentre 4 hanno la C-11
Ho subito controllato la tua modifica per capirci qualche cosa ma non sono riuscito a fare nulla di concreto.
So perfettamente che impostare una macro per andare a trovare queste piccole differenze è una rogna non da
poco quindi se te la senti e la puoi mettere a posto ne sarei contento.
Per non farti perdere tempo ti allego il file con la macro già modificata e un foglio “Freque-FineErrore”
dove sono evidenziate in rosso, le stringhe, nelle colonne su descritte.
Ringraziandoti mille e mille volte per il tuo prezioso aiuto cordialmente ikwae
http://www.filedropper.com/a7tab18divid ... opantyrete

[Anthony47]

Hummmm...
Dagli esempi avevo dedotto che il cambio colonna si pilotava al cambio della "ruota" scritta in chiaro in coda alle stringhe; evidentemente non e' così, ma nella descrizione non vedo descritta la vera regola da adottare. Devi quindi spiegare in quale circostanza i dati vanno posizionati nella colonna successiva.

Ciao

[ikwae]

Gentilissimo Anthony chiedo scusa per la mancata precisazione ma pensando che la macro prende
in automatico le stringhe non ho pensato alla descrizione ma adesso che me lo fai notare aggiungo
il cambio di colonna avviene quando una delle 4 chiavi nella stringa cambia.

Le chiavi sono all’interno di 4 celle AM39, AN39, AO39 e AP39 e, fintanto che non viene modificato
il valore di una di queste celle, le stringhe sono tutte omogenee e vanno tutte nella stessa colonna.

Quindi AM39, AN39, AO39, AP39 con nessuna variazione, del valore delle 4 celle, tutte le stringhe in una colonna
Con AM39, AN39, AO39, AP39 con anche una sola variazione, del valore di una sola cella, si cambia colonna.

Spero che sia utile e ancora scusa per la mancata precisazione sul post precedente cordialmente ikwae

[Anthony47]

Allora ho modificato questo blocco:

Codice: Seleziona tutto

With Sheets("Freque")
'With Sheets("Freque")
cPar = Sheets("TabRuSu").Range("AN39") & Sheets("TabRuSu").Range("AO39") & Sheets("TabRuSu").Range("AP39")
GetLU:
    lastdest = .Cells(Rows.Count, ColDest).End(xlUp).Row
    If cPar <> lPar And lastdest > 1 Then
        ColDest = ColDest + 1
        relast = True
    Else
        relast = False
    End If
    If relast Then GoTo GetLU
    .Cells(lastdest + 1, ColDest).Value = CL.Value
End With
lPar = cPar


Ho aggiunto le righe cPar= e lPar= e modificato l'If

Prova...

[ikwae]

Gentilissimo Anthony con la nuova modifica è tutto a posto ho fatto varie prove anche con estrazioni diverse è ok come
precisione nei conteggi. L’unico neo è per riempire 254 colonne, in continuo aumento, è lenta impiega diversi minuti ma per adesso la tengo così fintanto che non avrò finito di “smanettarla” e completarla in tutte le tabelle poi eventualmente aprirò un nuovo post chiedendo aiuto a tutto il Forum per velocizzarla.
Ringraziandoti mille e mille volte per la tuo gradito e apprezzato aiuto cordialmente ikwae

[Anthony47]

L’unico neo è per riempire 254 colonne, in continuo aumento, è lenta impiega diversi minuti ma per adesso la tengo così fintanto che non avrò finito di “smanettarla” e completarla in tutte le tabelle poi eventualmente aprirò un nuovo post chiedendo aiuto a tutto il Forum per velocizzarla

Ieri mi sono messo in modalita' lavativo e ho fatto il minimo richiesto...
Oggi mi sono applicato di piu'; senza stravolgere la sequenza della tua macro, anche perche' non ho compreso le elaborazioni da fare, mi sono limitato a ridurre al minimo le azioni che rallentano fortemente la velocita' delle macro, in questo caso selezione o lettura di celle, switch tra fogli di lavoro.
Il risultato e' questa macro:

Codice: Seleziona tutto

Sub Frequenze_TabRuSu_Help_Rete_REV1()
     Dim sh As Worksheet
    Dim rng As Range
    Dim p As Range
Dim OArr, myTim As Single, II As Long, AM39v, AN39v, AO39v, AP39v
        Dim UCella As String
        Dim CL As String '''As Range

   
Cancella_Foglio_Frequene
'Questa porzione di macro ha il compito di spazzolare tutta la
'tabella(TabRuSu)per torvare i valori cercati [p.Value >= 6 o altro valore]

ColDest = 2         '<< QUESTA mod Anty 'Anty 10/07/21 02:10

myTim = Timer
OArr = Range(Sheets("Ordinati").Range("B2"), Sheets("Ordinati").Range("B2").End(xlDown))

Application.ScreenUpdating = False
Sheets("TabRuSu").Select
Set sh = ThisWorkbook.Worksheets("TabRuSu")
Set rng = Range("TabelRuSu")
For Each p In rng
    If p.Value >= 4 Then            'Else GoTo 10
        cCnt = cCnt + 1
'        p.Select
        '=====================================================================================
         'Questa porzione di macro ha il compito di riempiere tre di quattro
         'celle con dei valori (la 4à cella si carica in automatico)
         'PRIMA CELLA
'        Range("AP39") = ActiveCell.EntireColumn.Cells(1).Value
        AP39v = Cells(1, p.Column).Value
'        Set rBase = ActiveCell
        Set rbase = p
        For i = 1 To 12
            If Evaluate("SUM(IFERROR(FIND(TabRuSu!B21:B38," & rbase.Offset(0, -i).Address & "),0))") > 0 Then 'PER RIGA -I
               'SECONDA CELLA
'               Range("AO39") = rbase.Offset(0, -i).Value
                AO39v = rbase.Offset(0, -i).Value
                Exit For
            End If
        Next i
'        rbase.Offset(0, -i).Select
'        Set cbase = ActiveCell '
        Set cbase = p.Offset(0, -i)
        For c = 1 To 19
             If Evaluate("SUM(IFERROR(FIND(TabRuSu!B39:B49," & cbase.Offset(-c, 0).Address & "),0))") > 0 Then 'PER COLO -c
               'TERZA CELLA
'               Range("AM39").Value = cbase.Offset(-c, 0).Value
                AM39v = cbase.Offset(-c, 0).Value
                Exit For
            End If
        Next c
        '=========================================================================================================
        'Questa porzione di macro ha il compito di confrontare
        'ogni stringa presente in colonna B foglio "Ordinati"...
''        Sheets("Ordinati").Select
''Debug.Print "A", Timer
        AN39v = Sheets("TabRuSu").Range("AN39").Value
        For II = 1 To UBound(OArr)
            CL = OArr(II, 1)
            pos = InStrRev(CL, " ")
            strlen = Len(CL)
''            If Left(CL, 2) = Sheets("TabRuSu").Range("AM39").Value And _
''             Mid(CL, 4, 3) = Sheets("TabRuSu").Range("AN39").Value And _
''             Mid(CL, 8, 4) = Sheets("TabRuSu").Range("AO39").Value And _
''             Right(CL, strlen - pos) = Sheets("TabRuSu").Range("AP39").Value Then 'Else GoTo 20
            If Left(CL, 2) = AM39v And _
             Mid(CL, 4, 3) = AN39v And _
             Mid(CL, 8, 4) = AO39v And _
             Right(CL, strlen - pos) = AP39v Then 'Else GoTo 20
                With Sheets("Freque")
                    cpar = Sheets("TabRuSu").Range("AN39") & AO39v & AP39v & AM39v
GetLU:
                    lastdest = .Cells(Rows.Count, ColDest).End(xlUp).Row
                    If cpar <> lpar And lastdest > 1 Then
                        ColDest = ColDest + 1
                        relast = True
                    Else
                        relast = False
                    End If
                    If relast Then GoTo GetLU
                    .Cells(lastdest + 1, ColDest).Value = CL
                End With
                lpar = cpar
            End If
20
        Next II
''Debug.Print "B", Timer
        aaaa = 1
    End If
10
'    Sheets("TabRuSu").Select 'Se Remmata Esce Errore Giallo In [p.Select]
Next p 'Ritorno Scansione Range TabRuSu '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Sheets("Freque").Select 'Visualizza Foglio
Application.ScreenUpdating = True
Debug.Print cCnt
Debug.Print Timer - myTim
End Sub


Il miglioramento c'e' ed e' tangibile; i risultati mi sembrano confrontabili

Prova anche tu...

[ikwae]

Gentilissimo Anthony che dire! Vediamo i tempi con la mia macro;
Con 256 colonne --> vado in cucina a prendere il caffè e ritornando ha ancora qualche secondo prima di finire
con 400 colonne --> vado in cucina preparo il caffè lo bevo e ritornando sta ancora girando per qualche minuto
con 754 colonne --> vado a vedere un film in tv e ritornando c’è ancora da attendere prima che finisca di girare
Con la tua macro 1.836 colonne forse 3(dico tre) secondi, ad essere molto abbondanti, è uno spettacolo
altro non c’è da aggiungere.
Ringraziandoti mille e mille volte per il tuo gradito e apprezzato aiuto oltre alla tua “Santa Collaborazione”
cordialmente ikwae