Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Macro Per Copia Incolla Con Criteri

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Macro Per Copia Incolla Con Criteri

Postdi ikwae » 29/07/21 01:25

Ciao a tutti… Ho realizzato delle macro per avere la frequenza delle vincite (virtuali)
i risultati sono ottimi aggiungo eccellenti, ma sono giusti? Sono veritieri?

Quindi ho realizzato una macro per confrontare le effettive potenzialità dei risultati.

La nuova macro, purtroppo, funziona al 99,9%. Copia e incolla i risultati, in colonna, sulla
stessa cella anziché accodarli. Ho fatto mille prove e, ricerche, ma i risultati non cambiano
addirittura ho applicato un contatore per l’offset che legge la cella A1 e scrive tutto accodando
i risultati giusti come richiesto ma solo 20 o 30 righe sotto che non va bene.

Ho capito che è qualche cosa di “struttura” della macro che non sono capace a metterla a posto.
Chiedo aiuto a tutto il Forum per modificare la parte finale della mia macro riferita copia e incolla.
Oppure, se necessita di una nuova struttura, una nuova macro con le stesse caratteristiche.

Basta cliccare sulla bandiera del foglio “6534_Tutte” e confrontare il risultato con il
foglio “6534_TutteFine” si capisce subito dove è l’errore nella mia macro.

La mia macro è semplice è spiegata bene nel listato (almeno spero) tuttavia la spiego e la
allego al post così, come penso, sia qualche cosa semplice non c’è bisogno di aprire l’allegato.

La macro compie le seguenti fasi;
1a) Scorre tutte le colonne del foglio “6534_Tutte” (sono all’incirca 1.000 ma per demo sul foglio sono 4)
2b) Seleziona l’ultima cella di ogni colonna (è necessaria l’ultima per il concorso)
le stringhe, in ogni colonna, sono uguali tra loro tranne [BA_Gr2_C-10 - 056 ambo Bari] in blu il concorso.
3c) Da questa cella la macro recupera 5 chiavi (evidenziati bene nel listato) per la ricerca e confronto.
4d) Si sposta sul foglio “Ordinati” e legge tutte le stringhe della colonna B da B2:B(end)
solitamente meno di 30 mila stringhe ma solo per demo ne ho lasciate 31.
5e) Per ogni stringa letta recupera le 5 chiavi come sopra.
6f) Confronta le 5 chiavi che siano tutte uguali tranne l’ultima, quella del concorso, deve essere maggiore
quindi se è maggiore [Estraz_1 > Estraz] copia la stringa e la incolla accodandola in colonna.

Questa è la riga di codice che non riesco a renderla dinamica
[CL.Copy Destination:=Sh2.Cells(lRiga, lCol).End(xlDown).Offset(6)]

In allegato un file con tre fogli come su specificati.
Ringraziando anticipatamente tutti coloro che mi possono aiutare. 73 ikwae
http://www.filedropper.com/965345necada ... ncollarete


Codice: Seleziona tutto
Sub Le_6534_Frequenze_Di_Frequenze_Rete()
   
    Dim lRiga As Long
    Dim lCol As Long
   'Dim rng As Range
    Dim LastC As Long
   'Dim uRig As Integer
    Dim UCella As String
    Dim CL As Range
    Dim sh1 As Worksheet
    Dim Sh2 As Worksheet

Set sh1 = Worksheets("Ordinati")
Set Sh2 = Worksheets("6534_Tutte")
 
   Sh2.Select
    LastC = Cells(1, Columns.Count).End(xlToLeft).Column
         
               For lCol = 3 To LastC 'INIZIA DALLA COLONNA C
                 For lRiga = 1 To 1
                   
             'SELEZIONA L'ULTIMA CELLA DI OGNI COLONNA DEL FOGLIO "6534_Tutte"
                    If Cells(lRiga, lCol).Value <> "" Then
                       Cells(lRiga, lCol).End(xlDown).Select
                                                   
            'RECUPERA DALLA STRINGA SELEZIONATA LE 5 CHIAVI DI IDENTITA'
                                       
                                                     'Stringa org [BA_Gr2_C-10 - 056 ambo Bari]
             RuotInut = Left(ActiveCell, 2)          'prende      [BA]
                  Grp = Mid(ActiveCell, 4, 3)        'prende         [Gr2]
                  Cna = Mid(ActiveCell, 8, 4)        'prende             [C-10]
               Estraz = CLng(Mid(ActiveCell, 15, 3)) 'prende                     [056] *********
                 
                  pos = InStrRev(ActiveCell, " ")
               strlen = Len(ActiveCell)
            RuFinAnno = Right(ActiveCell, strlen - pos) 'prende [Bari]
                 
                   Exit For
                End If
            Next lRiga
   
   'PASSA AL FOGLIO "Ordinati" E PERCORRE TUTTA LA COLONNA B
   sh1.Select
    UCella = Range("B2").End(xlDown).Address
       
        For Each CL In Range("B2:" & UCella)
   
             
      'RECUPERA, PER OGNI STRINGA LETTA, LE 5 CHIAVI DI IDENTITA'
             
             RuotInut_1 = Left(CL, 2)          'prende [BA]_Gr2_C-10 - 056 ambo Bari
                  Grp_1 = Mid(CL, 4, 3)        'prende BA_[Gr2]_C-10 - 056 ambo Bari
                  Cna_1 = Mid(CL, 8, 4)        'prende BA_Gr2_[C-10] - 056 ambo Bari
               Estraz_1 = CLng(Mid(CL, 15, 3)) 'prende BA_Gr2_C-10 -[056] ambo Bari ***********
   
                  pos_1 = InStrRev(CL, " ")
               strlen_1 = Len(CL)
            RuFinAnno_1 = Right(CL, strlen - pos) 'prende BA_Gr2_C-10 - 056 ambo [Bari]
 
 'SE LE 4 CHIAVI SONO UGUALI E, LA 5à CHIAVE CON L'ESTRAZIONE E' MAGGIORE, EFFETTUA IL COPIAINCOLLA
   
           If RuotInut = RuotInut_1 And _
                   Grp = Grp_1 And _
                   Cna = Cna_1 And _
             RuFinAnno = RuFinAnno_1 And _
               Estraz_1 > Estraz Then Else GoTo 10 '*************************
                                                  'SOLO QUESTA RIGA DEVE ESSERE > PER IL COPIA/INCOLLA
 
CL.Copy Destination:=Sh2.Cells(lRiga, lCol).End(xlDown).Offset(6) 'Grrrr... è statico
 
10
Next CL
Sh2.Select
Next lCol
End Sub
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 254
Iscritto il: 27/12/17 23:14

Sponsor
 

Re: Macro Per Copia Incolla Con Criteri

Postdi Anthony47 » 30/07/21 16:08

Non sono certo di aver capito quale e' la struttura dei dati in 6534_Tutte, ma in prima battuta ti suggerisco di modificare questa istruzione:
Codice: Seleziona tutto
'                CL.Copy Destination:=Sh2.Cells(lRiga, lCol).End(xlDown).Offset(6)     'ELIMINARE
                CL.Copy Destination:=Sh2.Cells(Rows.Count, lCol).End(xlUp).Offset(1)   'INSERIRE

Poi non so quanti dati devi elaborare, quindi non so se la struttura attuale e' idonea (in quanto a tempi di esecuzione)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17830
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro Per Copia Incolla Con Criteri

Postdi ikwae » 30/07/21 20:05

Grazie per aver risposto gentile come sempre... con la tua modifica funge molto bene come dovrebbe funzionare.
Nell’attesa di una risposta sono andato in giro a trovare ulteriori info e, su un post di pc-facile, ho trovato delle indicazioni che mi si è accesa la lampadina e ho partorito questo codice
al posto di questa riga
Codice: Seleziona tutto
'CL.Copy Destination:=Sh2.Cells(lRiga, lCol).End(xlDown).Offset(6) 'Grrrr... è statico

ho scritto questo
Codice: Seleziona tutto
CL.Copy
 Sh2.Activate
      Cells(lRiga, lCol).End(xlDown).Select
      ActiveCell.Offset(2, 0).Select
      ActiveCell.End(xlDown).Offset(1).Select
    ActiveSheet.Paste 

che mi ha risolto il problema… naturalmente userò la tua proposta anche perché è più “sicura” della mia.
Anche oggi ho fatto delle migliorie alla macro (sommare il concorso con la media) e ne devo fare delle altre quindi per adesso temporeggio fintanto non avrò finito.
Ringraziandoti mille e mille volte per il tuo prezioso aiuto cordialmente ikwae
Note: l’indicazione che ho nei miei appunti è
[Inbario 12/08/2016 13:32 vorrei creare una routine per selezionare un certo numero di celle]

e queste le parole per l’accensione della lampadina
'seleziona dalla cella attiva per un offset pari ai valori di input
Range(ActiveCell, ActiveCell.Offset(x, y)).Select
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 254
Iscritto il: 27/12/17 23:14


Torna a Applicazioni Office Windows


Topic correlati a "Macro Per Copia Incolla Con Criteri":


Chi c’è in linea

Visitano il forum: Nessuno e 58 ospiti