Aiutamici Forum
Benvenuto Ospite Cerca | Topic Attivi | Utenti | | Log In | Registra

[Excel 2007] - Tabelle Pivot e filtri Opzioni
a10n11
Inviato: Thursday, May 12, 2011 11:28:22 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
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


aetio
Inviato: Thursday, May 12, 2011 11:47:10 AM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
provato... CENTRO!! (come s-e-m-p-r-e)
Grazie infinite (come infiniti sono i frattali di Mandelbrot...) e buon pomeriggio,
eZio

ps adesso per un pò ti lascio in pace...
di rompiscatole come me ne basta uno a lustro... e io qui praticamente sono quotidiano!! ahahahahahahaha
Utenti presenti in questo topic
Guest


Salta al Forum
Aggiunta nuovi Topic disabilitata in questo forum.
Risposte disabilitate in questo forum.
Eliminazione tuoi Post disabilitata in questo forum.
Modifica dei tuoi post disabilitata in questo forum.
Creazione Sondaggi disabilitata in questo forum.
Voto ai sondaggi disabilitato in questo forum.

Main Forum RSS : RSS

Aiutamici Theme
Powered by Yet Another Forum.net versione 1.9.1.8 (NET v2.0) - 3/29/2008
Copyright © 2003-2008 Yet Another Forum.net. All rights reserved.