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

[Excel 2007]-Evidenziare celle visibili con condizione/ Variante Opzioni
aetio
Inviato: Sunday, January 22, 2012 6:02:02 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
devo risolvere un problema, che in realtà è una variante di quello già visto QUI

Le differenze sostanziali sono:
-il Box in Tabella1 anziché essere di 1+10 righe è di 1+15
-le celle dei codici da evidenziare sono solo all’interno di questo Box15
-la condizione perché vengano evidenziati è che i codici siano presenti nel Box15 almeno per 2 volte
-i codici esterni al Box (quelli a -5/+5 rispetto al Box10 della macro di riferimento) in questa ricerca non ci interessano, quindi le relative istruzioni vanno ignorate.

Come al solito- dato che si tratta di istruzioni molto elaborate e sopra tutto precise, anche da un punto di vista di linguaggio VBA ...quindi per me, a questi livelli, è buio pesto- chiedo l’ennesimo (nel vero senso della parola) aiuto.
Grazie infinite, buona giornata
eZio
Sponsor
Inviato: Sunday, January 22, 2012 6:02:02 PM

 
a10n11
Inviato: Tuesday, January 24, 2012 10:22:05 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
servirebbe una rinfrescata per ricostruire la logica.
la macro che segue, elabora la tabella in questo modo.

prende come riferimento la cella selezionata della tabella1
crea un'area di lavoro di 15 righe, per ogni valore nell'area controlla quanti sono i valori ripetuti,
se maggiori o uguali a 2 assegna un colore di sfondo.

Sub tabella15()
riga = ActiveCell.Row
Set Area = Range(Cells(riga, 3), Cells(riga + 15, 7))
Area.Interior.ColorIndex = xlNone
For Each cla In Area
If cla.Interior.ColorIndex = xlNone Then
x = Application.WorksheetFunction.CountIf(Area, cla.Value)
If x >= 2 Then
For Each cl2 In Area
If cl2 = cla Then
cl2.Interior.ColorIndex = 3
End If
Next
End If
End If
Next
End Sub

saluti
Giap

aetio
Inviato: Tuesday, January 24, 2012 5:21:17 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
scusa se non mi sono dilungato nell'approfondire la richiesta, perché avrei ripetuto gran parte di quanto già esposto nel 3d del LINK...

Ecco in sostanza la variante di cui ho bisogno.
SITUAZIONE DI PARTENZA (esempio):



Tabella1 in giallo, Tabella2 in verde
Tabelle filtrate sul codice 8 di col.P

Situazione specifica di col.O (tabella2) osservando la col.B:
il cod.70 presente in magazzino nel Sett.73’21
il cod.18 presente nel Sett.73’06
il cod.74 presente nel Sett.72’94

la macro del 3d linkato, quella a fine 3d, in base alla selezione dell'intervallo filtrato di col.O intercetta nella tabella1 non filtrata i sett. corrispondenti (in col.B) e crea per ciascuno di essi un Box10 di range "C:G" comprendente la riga del sett. intercettato più 10 righe superiori,



poi intercetta in tabella1 i codici di tabella2-selezione e:
-se sono esterni, ma entro le 4 righe in basso rispetto al Box10 a cui si riferiscono, in tabella2-selezione ne colora di verde la cella
-se sono esterni, ma entro le 4 righe in alto rispetto al Box10 a cui si riferiscono, in tabella2-selezionene ne colora di azzurro la cella
-se sono interni al Box10 li ignora



Nella macro c'è poi un gruppo di istruzioni

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

che in questa ricerca non ci interessano.

le differenze rispetto alla richiesta del 3d del link, e relativa macro, sono:
-il Box in Tabella1 anziché essere di 1+10 righe è di 1+15
-le celle dei codici da evidenziare nella selezione di tabella2 sono solo quelle all’interno di questo "Box15"
-la condizione perché vengano evidenziati è che i codici siano presenti nel Box15 almeno per 2 volte
-i codici esterni al Box (quelli a -5/+5 rispetto al Box10 della macro di riferimento) in questa ricerca non ci interessano.
Spero di avere illustrato in modo chiaro il problema,
Grazie assai e buona serata,
eZio


Nota: la macro che mi hai preparato mi è stata utilissima per risovere un altro degli innumerevoli problemi disseminati nel "teatro delle mie operazioni"................. :)))) Grazie!!
a10n11
Inviato: Tuesday, January 24, 2012 7:16:28 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
ho provato a ricostruire la logica del lavoro fatto precedentemente.
vedi se queste modifiche fatte alla macro portano al risultato voluto.

Sub coloraselezione15()
Dim rng As Range, rng1 As Range, rng2 As Range, area15 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("B3", Range("B3").End(xlDown))
Set rng1 = Range(Cells(3, 3), Cells(rng.Rows.Count + 2, 7))
With rng1
.Interior.ColorIndex = xlNone
End With
Set rng1 = Nothing

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 - 15

If blk1 <= 3 Then blk1 = 3
'
'-------------------------------------------------------------------------
Set area15 = Range(Cells(blk1, 3), Cells(riga, 7))

'*****************
For Each mval3 In area15
If mval3.Interior.ColorIndex = xlNone Then
Ccont = Application.WorksheetFunction.CountIf(area15, mval3.Value)
If Ccont >= 2 Then
For Each cl2 In area15
If cl2 = mval3 Then
cl2.Interior.ColorIndex = 3
End If
Next
End If
End If
Next mval3
End If
Next sett
Ctrl = False
Next Itx
Set area15 = Nothing
Set Area = Nothing
Set rng = Nothing

End Sub


saluti
Giap

aetio
Inviato: Tuesday, January 24, 2012 11:23:07 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
ho provato la macro, ma purtroppo non risolve il mio problema...
ho preparato un SAMPLE per chiarire cosa dovrebbe fare e cosa fa la macro, sperando di chiarire ciò che con essa devo fare.
Per chiarezza esplicativa in tabella1 ho colorato solo i Box15 dei codici filtrati di tabella2-selezione che nel Box15 si ripetono almeno due volte.
Grazie assai per la somma pazienza, buona notte
eZio




a10n11
Inviato: Wednesday, January 25, 2012 10:38:20 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
il file di esempio chiarisce la logica che intendi applicare.
Quello che non arrivo a capire è questo:

applichi un filtro per colore nella colonna H - Quale colore Filtri? il rosso??
se si perchè il prio box15 parte da riga 22 e non da riga 13??


la macro è già fatta ma ho bisogno di sapere con esattezza la logica del filtro che applichi.
saluti
Giap



aetio
Inviato: Wednesday, January 25, 2012 12:54:22 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
scusami, ma ho potuto accedere alla rete solo ora...

Commenta:
applichi un filtro per colore nella colonna H - Quale colore Filtri? il rosso??

affermativo: filtro per colore rosso

Commenta:
se si perchè il prio box15 parte da riga 22 e non da riga 13??

come ho scritto sopra, ho colorato solo i Box15 dei codici filtrati di tabella2-selezione che nel Box15 si ripetono almeno due volte perché altrimenti sarebbe uscita un'arlecchinata poco comprensibile, ma hai perfettamente ragione... il primo Box15 è a riga 13, poi a riga 22, 49, 97, 189, 249, 262, 273.

Grazie assai
e buon pomeriggio
eZio



a10n11
Inviato: Wednesday, January 25, 2012 5:00:58 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
con la premessa che la macro è tutta da provare, eccola!
Sub coloraselezione15()
Dim rng As Range,rng2 As Range, area15 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("B3", Range("B3").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 - 15

If blk1 <= 3 Then blk1 = 3
'
'-------------------------------------------------------------------------
Set area15 = Range(Cells(blk1, 3), Cells(riga, 7))
Set tab2_15 = Range(Cells(blk1, col), Cells(riga, col))
tab2_15.Select
'*****************
For Each mval3 In area15
Ccont = Application.WorksheetFunction.CountIf(area15, mval3.Value)
If Ccont >= 2 Then
For Each cl2 In tab2_15
If cl2 = mval3 Then
cl2.Interior.ColorIndex = 5
End If
Next
End If
Next mval3
End If
Next sett
Ctrl = False
Next Itx
Set area15 = Nothing
Set Area = Nothing
Set rng = Nothing
End Sub


saluti
Giap


aetio
Inviato: Wednesday, January 25, 2012 6:12:03 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
direi proprio che siamo sulla strada giusta!! ;)))
ho riscontrato alcune anomalie nel lavoro della macro, che ho evidenziato nel FOGLIO2 del SAMPLE
Il FOGLIO2 (2) in realtà è il FOGLIO2 senza filtro, diversamente da quanto scritto nel foglio stesso...
Grazie infinite e buona serata, come sempre sei il migliore in assoluto, sia tecnicamente, sia in stile....
eZio


ps. hai visto il mio TATONE com'è caro e bello?? (click sul mio nome) ;))
quanto m'insegna, pur non parlando....
a10n11
Inviato: Wednesday, January 25, 2012 7:31:02 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
ho scaricato il file ma lo posso guardare solo domattina se non è proprio impellente.

Ps. bel cagnolone, si vede che in famiglia la fa da padrone..
questo invece è l'ultimo arrivato in famiglia. Scelta obbligata per evitargli il parcheggio in canile


saluti
Giap


a10n11
Inviato: Wednesday, January 25, 2012 7:46:28 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
dopo una occhiata al volo al tuo file, non mi pare di riscontrare errori.
il record da te indicato rigo 249 è normale che sia colorato di blu perchè appartiene al box 15 di pertinenza del valore 146 di riga 262

se così non dovesse essere va rivista completamente tutta la macro.
saluti
Giap

aetio
Inviato: Wednesday, January 25, 2012 8:21:35 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
Commenta:
ho scaricato il file ma lo posso guardare solo domattina se non è proprio impellente.

non c'è alcun problema...!! ;))

Purtoppo il "capocommessa" è il codice che inizialmente è nella cella di colore ROSSO, in tabella2 filtrata-selezione, anche se poi in tabella1 sarà contenuto in un altro Box15.
Il fatto che non si ripete all'interno del proprio Box15 (da esso generato, indipendentemente dalla sua posizione relativa nel Box15 di un altro codice) lo esclude dai requisiti di modifica del colore-cella da ROSSO a BLU.
Grazie infinite per la immensa pazienza, buona serata
eZio


Inizio OT
_ps. il tuo cucciolone è davvero bellissimo!! ...e saprà di sicuro meritarsi tutto il vostro affetto ;))
Socrate, uno dei Filosofi a me più cari in assoluto, disse: "più conosco la gente, più amo il mio Cane"...
E hai azzeccato in pieno, il mio Bilbo la fà da padrone _Fine OT.
a10n11
Inviato: Thursday, January 26, 2012 10:07:12 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
forse ho capito il concetto di "capocommessa"..!!

la macro postata, controllava i doppioni nel box 15 e li comparava non al solo capocommessa ma a tutte le righe del box 15.
vedi se ora la soluzione è corretta:

Sub coloraselezione15()
Dim rng As Range, rng2 As Range, area15 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("B3", Range("B3").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 - 15

If blk1 <= 3 Then blk1 = 3
'
'-------------------------------------------------------------------------
Set area15 = Range(Cells(blk1, 3), Cells(riga, 7))
'*****************
For Each mval3 In area15
Ccont = Application.WorksheetFunction.CountIf(area15, mval3.Value)
If Ccont >= 2 Then
If mval3 = Itx Then
Itx.Interior.ColorIndex = 5
End If
End If
Next mval3
End If
Next sett
Ctrl = False
Next Itx
Set area15 = Nothing
Set Area = Nothing
Set rng = Nothing
End Sub

saluti
giap

aetio
Inviato: Thursday, January 26, 2012 11:18:20 AM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
controllo effettuato, perfetta!!
Gran bella macro anche questa, di un'incomparabile eleganza (come tutte le tue "creature" del resto...).
Ti ringrazio infinitamente, buona giornata
eZio
a10n11
Inviato: Thursday, January 26, 2012 12:37:54 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
non si tratta altro che una riacconciatura della vecchia macro. Solo che stavolta c'erano di mezzo il "capocommessa" che non era stato interpretato nella giusta maniera.
saluti
Giap

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.