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

[Excel 2007]-Modifica macro/righe filtrate Opzioni
aetio
Inviato: Saturday, August 24, 2013 9:57:19 AM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
sto cercando di adattare questa stupenda macro per farla girare su una serie di tabelle con righe filtrate:

Sub Evidenza_max9()
For I = 8 To 33
Uriga = Cells(Rows.Count, 8).End(xlUp).Row
For Each cl In Range(Cells(3, I), Cells(Uriga, I))
X = cl.Row
If cl.Interior.ColorIndex = xlNone Then
cnt = cnt + 1
Else
If cnt >= 9 Then
Set mrange = Cells(cl.Row - cnt, I).Resize(cnt, 1)
With mrange
.Interior.ColorIndex = 4
.Borders.Weight = xlThick
.Borders.LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Set mrange = Nothing
End If
cnt = 0
End If
Next
If X = Uriga And cnt >= 9 Then
Set mrange = Cells(X - (cnt - 1), I).Resize(cnt, 1)
With mrange
.Interior.ColorIndex = 4
.Borders.Weight = xlThick
.Borders.LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
cnt = 0
Set mrange = Nothing
End If
cnt = 0
Next I
End Sub

ma siccome sono ancora un emerito imbranato in vba non riesco a scrivere i giusti codici affinché la macro possa svolgere egregiamente il suo compito... Mi incarto come un grullo intorno a questo concetto
Range("h3", Range("ag" & Uriga)).SpecialCells(xlCellTypeVisible)
che però evidentemente in questo caso deve essere scritto in altro modo...
Attualmente dovendo applicare questa macro su tabelle con righe filtrate "pasticcio" in questo modo: prima filtro le tabelle, poi le copio- filtrate- in altro foglio e da lì applico la macro... :-\\
Grazie infinite per la pazienza, buona giornata
eZio
Sponsor
Inviato: Saturday, August 24, 2013 9:57:19 AM

 
aetio
Inviato: Saturday, August 24, 2013 10:24:24 AM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
EDIT

rimango in questo thread evitando di aprirne un altro inutilmente, dato che l'argomento è strettamente legato alla macro di cui sopra...

Una volta terminato il lavoro della macro, attualmente seleziono manualmente l'intervallo di celle colorate di ColorIndex 4 individuate dalla macro e applico alla selezione quest'altro capolavoro di istruzioni che, a seconda della tipologia di circostanze definite dai parametri scritti nella macro stessa, colora in modo appropriato le varie celle della selezione:

Sub ab_coloraselezione()
Dim rng As Range, rng1 As Range, rng2 As Range, area10 As Range
Dim mysett As Variant, sett As Variant, Itx As Variant
Dim Mval As Variant, Mval2 As Variant, mval3 As Variant
Dim Area As Range, ctrl As Boolean

Set rng = Range("h3", Range("h3").End(xlDown))
col = Selection.Column
counter = 0
'--------------------------------------
' Definisce l'area di selezione e conta le righe della selezione
miorange = Selection.Address
Set Area = Range(miorange).SpecialCells(xlCellTypeVisible)
For Each sel In Area
righe = righe + sel.Rows.Count
Next
'-------------------------------------------

For Each Itx In Area
counter = counter + 1
mysett = Cells(Itx.Row, 2).Value
I = Itx.Row
Do While Cells(I + 1, col).EntireRow.Hidden = True
I = I + 1
Loop

' il contatore serve per definire il limite di NextItx nel caso di selezioni parziali
'dei codici visibili-------------------------------------------------------
If counter < righe Then
NextItx = Cells(I + 1, col).Value
Else
NextItx = ""
End If
'-------------------------------------------------------------
For Each sett In rng
If sett = mysett Then
riga = sett.Row
'---------------------controllo Riga della selezione
blk1 = riga - 10
blk2 = riga - 15
blk3 = 5
If blk1 <= 3 Then blk1 = 3
If blk2 < 3 And blk1 > 3 Then
blk2 = 3
ElseIf blk1 <= 3 Then
ctrl = True
End If
'-------------------------------------------------------------------------
Set area10 = Range(Cells(blk1, 3), Cells(riga, 7))
If Not ctrl Then
Set rng1 = Cells(blk2, 3).Resize(5, 5)
For Each Mval In rng1
If Mval.Value = Itx Then
Itx.Interior.ColorIndex = 37
Exit For
End If
Next Mval
End If
Set rng2 = Cells(riga, 3).Offset(1, 0).Resize(blk3, 5)
For Each Mval2 In rng2
If Mval2 = Itx And Itx.Interior.ColorIndex = xlNone Then
Itx.Interior.ColorIndex = 43
End If
Next Mval2
If NextItx = "" Then GoTo fine
For Each mval3 In area10
If mval3 = NextItx Then
With Cells(I + 1, col).Borders
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 3
End With
Exit For
End If
Next mval3
Exit For
End If
Next sett
ctrl = False
Next Itx
fine:
Set area10 = Nothing
Set Area = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
End Sub

Come posso tecnicamente collegare questa macro alla precedente in modo che l'operazione attualmente manuale diventi automatica? Credo con il comando Call (o se esterna con Application.Run"XX"), ma... questa affascinante e stupenda Materia non contempla "misure a spanne" ;-))
La macro ab_coloraselezione lavora già contemplando la filtratura, quindi il collegare le due macro non dovrebbe creare alcun problema in tal senso.
Grazie infinite,
eZio
a10n11
Inviato: Monday, August 26, 2013 10:01:24 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
la macro evidenza_Max9()
controlla i valori della tabella che non abbiano colore di sfondo su una tabella non filtrata.
Per l'istruzione: Range("h3", Range("ag" & Uriga)).SpecialCells(xlCellTypeVisible)
devi definire cosa deve fare.
es. definirla come variabile: set miorange=Range("h3", Range("ag" & Uriga)).SpecialCells(xlCellTypeVisible)
oppure usarla come range di selezione: Range("h3", Range("ag" & Uriga)).SpecialCells(xlCellTypeVisible).select
dipende che uso ne vuoi fare.

Per il richiamo della macro
basta inserire il comando
Call ab_coloraselezione
dopo l'ultima istruzione della macro in esecuzione accertandoti che le variabile siano correttamente assegnate.
es. l'istruzione miorange = Selection.Address
si aspetta che ci sia un range del foglio selezionato.


saluti
Giap



aetio
Inviato: Monday, August 26, 2013 12:25:09 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
come SEMPRE sei stato chiarissimo e hai risolto il mio problema... ;-))
Grazie assai e buona giornata
eZio.

[Nota: ...che le tue ferie durino moooooolto a lungo!! :-)) ]
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.