Moderatori: Anthony47, Flash30005
Sub BBB_Le_6534_Fai_Tu()
Dim UCella As String
Dim radice As String
Dim RuFinAnno As String
Dim CL As Range
'' Dim CL1 As Range
Dim myMatch, cCL, mySplit, dBg As Boolean, oArr(), Conta As Long
Dim UB1 As Long, UB2 As Long, cCnt As Long, myTim As Single, Zona
Dim CumM As Long, cCol As Long, I As Long, J As Long
'
Conta = 4 '<<<<
'
myTim = Timer
dBg = False
Set Zona = Worksheets("Riferimento").Range("C2:C6535")
Sheets("Ordinati").Select
ReDim oArr(0 To 100, 1 To Range("A4").End(xlDown).Row)
UCella = Range("B2").End(xlDown).Address
For Each CL In Range("B2:" & UCella)
cCL = CL.Value
myMatch = 0
mySplit = Split(cCL & " ##", " ", , vbTextCompare)
radice = mySplit(0) & " " & mySplit(UBound(mySplit) - 1)
'SETTA DOVE CONFRONTARE
CumM = 0
Do
If IsError(myMatch) Then Exit Do
Set Zona = Worksheets("Riferimento").Range("C" & (2 + CumM) & ":C6536") 'WWWWW
myMatch = Application.Match(radice, Zona, False)
If Not IsError(myMatch) Then
CumM = CumM + myMatch
cCol = Range(Zona.Cells(myMatch, 1).Offset(0, -1).Value & 1).Column
oArr(oArr(0, cCol) + 1, cCol) = cCL
oArr(0, cCol) = oArr(0, cCol) + 1
If dBg Then Debug.Print Sheets("6534_Tutte").Range(Zona.Cells(myMatch, 1).Offset(0, -1) & Rows.Count).End(xlUp).Offset(1, 0).Address, CL.Row
End If
Loop
DoEvents
If CL.Row > 100000 Then Exit For
Next 'CL
Sheets("6534_Tutte").Select
Debug.Print "Fine B: " & Format(Timer - myTim, "0.00") ', CL.Row
'
UB2 = UBound(oArr, 2)
UB1 = UBound(oArr)
For I = 1 To UB2
If oArr(0, I) >= Conta Or I < 3 Then
cCnt = cCnt + 1
oArr(0, I) = Sheets("ordinati").Range("A4").Cells(I, 1)
For J = 0 To UB1
oArr(J, cCnt) = oArr(J, I)
If oArr(J, cCnt) = "" Then Exit For
Next J
End If
Next I
Range("A1").Resize(UB1, UB2).ClearContents
Range("A1").Resize(UB1, cCnt).Value = oArr
Debug.Print "Fine BB: " & Format(Timer - myTim, "0.00") ', CL.Row
MsgBox ("Completato; num colonne: " & cCnt)
End Sub
Con un controllo più accurato e contando le stringhe che dovrebbero essere 5.466 mi sono accorto, dopo che la macro ha finito con Conta=4, che sono 5.486 quindi 17 stringhe in più.
Quindi ho capito che le macro incolla sulla colonna le stringhe giuste e di appartenenza della colonna
ma, alcune volte, non si sa come o quando, sempre le ultime una due o tre stringhe e come se li tenesse in
memoria, dopo averle scritte bene nella sua colonna li scrive, lasciando una cella libera, in una
colonna che non ha nulla a che vedere con quelle stringhe
For J = 0 To UB1
oArr(J, cCnt) = oArr(J, I)
'If oArr(J, cCnt) = "" Then Exit For '<----TOGLIERE
Next J
Loop
' DoEvents '<---- Si puo' togliere
If CL.Row > 100000 Then Exit For
Torna a Applicazioni Office Windows
Ordinare colonne sulla stessa riga se stesso contenuto Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 10 |
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Stabilire righe e colonne da mostrare a schermo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 10 |
Visitano il forum: Nessuno e 20 ospiti