salve
prova queste modifiche:
Public Cl As Variant
Public sequenza As Long
Public myrow As Long
Public crit As Variant
Public urig As Long
Public colore As Long
Public colfil As Long
Public N As Long
Sub filtrasequenza()
Sheets("foglio1").Select
Application.ScreenUpdating = False
If Sheets("foglio1").AutoFilterMode Then
Selection.AutoFilter
End If
Range("A1").AutoFilter
urig = Range("A" & Rows.Count).End(xlUp).Row
With Sheets("foglio2")
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlNone
End With
sequenza = CLng(InputBox("SEQUENZA", "Dichiara limite sequenza"))
colore = 3
For N = 8 To 33
Set miaColl = New Collection
Set AreaCol = Range(Cells(3, N), Cells(urig, N))
For Each Clx In AreaCol
On Error Resume Next
miaColl.Add Clx, CStr(Clx)
On Error GoTo 0
Next
For y = 1 To miaColl.Count
Selection.AutoFilter Field:=N, Criteria1:=miaColl(y)
Call TabellaTabelle
Next y
Selection.AutoFilter Field:=N
Set miaColl = Nothing
Set AreaCol = Nothing
Next N
Application.ScreenUpdating = True
End Sub
Sub TabellaTabelle()
Dim ctr As Boolean, ctr2 As Boolean
Dim miaColl As Collection
conta = 0
For i = 8 To 33
Set area = Range(Cells(3, i), Cells(urig, i)).SpecialCells(xlCellTypeVisible)
Lastfilt = Cells(Cells.Rows.Count, i).End(xlUp).Row
If area.Cells.Count < sequenza Then Exit For
For Each Cl In area
If Cl.Interior.ColorIndex = xlNone Then
conta = conta + 1
If Not ctr2 Then
myrow = Cl.Row
End If
ctr2 = True
If Cl.Row = Lastfilt Then GoTo dopo
Else
dopo:
If conta = sequenza Then
Call copiaDati
With Sheets("foglio2").Cells(myrow, N).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
End With
Else
End If
conta = 0
ctr2 = False
End If
Next
conta = 0
ctr2 = False
Set area = Nothing
Next
End Sub
Sub copiaDati()
colonna = Cl.Column
With Sheets("foglio2")
With .Cells(myrow, colonna).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
End With
End With
End Sub
Ora con queste modifiche, ad ogni valore (corrispondente alla ricerca) avrai sulla stessa riga il codice che
l'ha generato.
saluti
Giap