Per quanto riguarda le ricerche 3*1 /3*2 ho immaginato che in Y1 (ma la cella puo' essere impostata nel codice) si scriva 1 oppure 2 per indicare la semplificazione da esaminare, poi si puo' usare questa macro:
- Codice: Seleziona tutto
Sub TreX21()
Dim bDati As String, FlxX As String, lLine As Long
Dim eArr, tArr(1 To 117480, 1 To 3), wArr(1 To 117480, 1 To 4) As Long, oArr(1 To 117480, 1 To 4), olArr
Dim I As Long, J As Long, A1 As Long, A2 As Long, A3 As Long, myTim As Single
Dim tCnt As Long, olCnt As Long, cEstr As Long, my1OR2 As Long, cDel As Long
bDati = "D4" '<<< L'origine dei dati
FlxX = "Y1" '<<< Indicazione 3 * x; se <1 o >2 la macro termina subito
Range(Range("AE4"), Cells(Rows.Count, "AL").End(xlUp)).ClearContents
my1OR2 = Range(FlxX)
If my1OR2 <> 2 And my1OR2 <> 1 Then
MsgBox ("Contenuto di " & FlxX & " errato (valori ok: 1 o 2)")
Exit Sub
End If
eArr = Range(Range(bDati), Range(bDati).Offset(0, 19).End(xlDown)).Value
olArr = Application.WorksheetFunction.Index(eArr, 2, 0)
lLine = UBound(eArr, 1)
For A1 = 1 To 88
myTim = Timer
For A2 = A1 + 1 To 89
For A3 = A2 + 1 To 90
tCnt = tCnt + 1
tArr(tCnt, 1) = A1: tArr(tCnt, 2) = A2: tArr(tCnt, 3) = A3
For I = 1 To lLine
olCnt = 0
For J = 1 To 20
cEstr = eArr(I, J)
If cEstr = A1 Then
olCnt = olCnt + 1
ElseIf cEstr = A2 Then
olCnt = olCnt + 1
ElseIf cEstr = A3 Then
olCnt = olCnt + 1
End If
If olCnt = my1OR2 Then Exit For
Next J
'
If olCnt = my1OR2 Then
wArr(tCnt, 1) = wArr(tCnt, 1) + 1
cDel = I - wArr(tCnt, 2)
wArr(tCnt, 2) = I
If cDel > wArr(tCnt, 3) And I < lLine Then wArr(tCnt, 3) = cDel
End If
'DoEvents
Next I
Next A3
Next A2
Debug.Print A1, Format(Timer - myTim, "0.00")
DoEvents
Next A1
'
'Calcola i parametri di ogni ambo:
For I = 1 To UBound(wArr)
oArr(I, 1) = lLine - wArr(I, 2)
oArr(I, 2) = wArr(I, 1)
oArr(I, 4) = wArr(I, 3) - 1
oArr(I, 3) = oArr(I, 1) - oArr(I, 4)
Next I
'Output
Range("AE4").Resize(UBound(tArr), 3) = tArr
Range("AI4").Resize(UBound(oArr), 4) = oArr
MsgBox ("Completato...")
End Sub
La durata della macro e' comunque nel range di molti minuti, comunque meno di quanto richiesto dalla Sub Terni3x2 inserita nel file pubblicato. I tempi di esecuzione possono essere dedotti guardando il contenuto della "finestra Immediata" (il log deve evolvere da 1, 2, 3... fino a 88).
Le versione 2*1 e' derivata da questa prima macro; non richiede l'uso della cella Y1 ed e' abbastanza rapida:
- Codice: Seleziona tutto
Sub DueX1()
Dim bDati As String, FlxX As String, lLine As Long
Dim eArr, tArr(1 To 4005, 1 To 3), wArr(1 To 4005, 1 To 4) As Long, oArr(1 To 4005, 1 To 4)
Dim I As Long, J As Long, A1 As Long, A2 As Long, A3 As Long, myTim As Single
Dim tCnt As Long, olCnt As Long, cEstr As Long, my1OR2 As Long, cDel As Long
bDati = "D4" '<<< L'origine dei dati
Range(Range("AE4"), Cells(Rows.Count, "AL").End(xlUp)).ClearContents
my1OR2 = 1
eArr = Range(Range(bDati), Range(bDati).Offset(0, 19).End(xlDown)).Value
lLine = UBound(eArr, 1)
'For A1 = 1 To 88
myTim = Timer
For A2 = A1 + 1 To 89
For A3 = A2 + 1 To 90
tCnt = tCnt + 1
tArr(tCnt, 1) = A2: tArr(tCnt, 2) = A3 ': tArr(tCnt, 3) = A3
For I = 1 To lLine
olCnt = 0
For J = 1 To 20
cEstr = eArr(I, J)
If cEstr = A3 Then
olCnt = olCnt + 1
ElseIf cEstr = A2 Then
olCnt = olCnt + 1
' ElseIf cEstr = A3 Then
' olCnt = olCnt + 1
End If
If olCnt = my1OR2 Then Exit For
Next J
'
If olCnt = my1OR2 Then
wArr(tCnt, 1) = wArr(tCnt, 1) + 1
cDel = I - wArr(tCnt, 2)
wArr(tCnt, 2) = I
If cDel > wArr(tCnt, 3) And I < lLine Then wArr(tCnt, 3) = cDel
End If
'DoEvents
Next I
Next A3
Next A2
Debug.Print A1, Format(Timer - myTim, "0.00")
DoEvents
'Next A1
'
'Calcola i parametri di ogni ambo:
For I = 1 To UBound(wArr)
oArr(I, 1) = lLine - wArr(I, 2)
oArr(I, 2) = wArr(I, 1)
oArr(I, 4) = wArr(I, 3) - 1
oArr(I, 3) = oArr(I, 1) - oArr(I, 4)
Next I
'Output
Range("AE4").Resize(UBound(tArr), 3) = tArr
Range("AI4").Resize(UBound(oArr), 4) = oArr
MsgBox ("Completato...")
End Sub
Ciao
