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