Se i dati sono in colonna A, da A2 verso il basso, e i risultati si vogliono riepilogare in colonna F:G, allora prova questo codice:
- Codice: Seleziona tutto
Dim DArr
Sub peppa()
Dim I As Long, J As Long, K As Long, SerCnt As Long
Dim LastA As Long, mySer As String, myTim As Single
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
myTim = Timer
DArr = Range("A1").Resize(LastA, 1).Value
With Range("F2").Resize(Rows.Count - 2, 2)
.ClearContents
.NumberFormat = "@"
End With
For I = 2 To 5
For J = 2 To LastA - I
SerCnt = 0
mySer = GetSer(I, J)
If mySer <> "" Then
For K = J To LastA - I
If GetCSer(I, K) = mySer Then SerCnt = SerCnt + 1
Next K
If SerCnt > 1 Then
Cells(Rows.Count, "F").End(xlUp).Offset(1, 0) = mySer
Cells(Rows.Count, "F").End(xlUp).Offset(0, 1) = SerCnt
End If
End If
Next J
Next I
MsgBox ("Completato (" & Format(Timer - myTim, "0.00") & " Sec)")
End Sub
Function GetSer(ByVal myI, myJ) As String
Dim II As Long, Ser As String
'
For II = 0 To myI - 1
Ser = Ser & "-" & DArr(myJ + II, 1)
Next II
Ser = Mid(Ser, 2, 999)
If Application.WorksheetFunction.CountIf(Range("F1").Resize(10000, 1), Ser) > 0 Then
GetSer = ""
Else
GetSer = Ser
End If
End Function
Function GetCSer(ByVal myI As Integer, ByVal myK As Integer)
Dim II As Long, Ser As String
'
For II = 0 To myI - 1
Ser = Ser & "-" & DArr(myK + II, 1)
Next II
Ser = Mid(Ser, 2, 999)
GetCSer = Ser
'
End Function
Va messo all' interno di un "nuovo Modulo", e poi lanciata la macro peppa.
In colonna F saranno riepilogate le sequenze con almeno 2 occorrenze, in colonna G il numero di occorrenze.
Volendo puoi ordinare questo elenco secondo i criteri di tuo interesse, accodando una macro autoregistrata.
Flash, io non sono riuscito a far funzionare la tua macro, forse perche' non ho capito quali passi iniziali fare.
Ciao