|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, non si può dire che stia con le mani in mano.... ahahah a10n11 mi ha appena risolto in modo geniale un grande problema... e già sono alle prese con un'altra tipologia di analisi delle tabelle che ormai sogno anche di notte :)) Nella FOTO è sintetizzato il quesito: In una tabella (da col.H a col.AG) ho delle celle bordate e colorate, per evidenziarne il valore. In col.AH viene applicato un filtro da 1 a 10 a seconda dell'esigenza dell'analisi da fare alla tabella (questa è la variabile che condiziona il risultato delle righe messe in evidenza da Excel), esigenza dettata dalla necessità di dover ridurre drasticamente determinate carenze causate principalmente da un'insufficiente qualità di monitoraggio del magazzino. In sostanza dovrei impostare o una serie di formule o una macro che mi consenta di evidenziare le volte che in una data colonna della tabella NON si soddisfano le condizioni che segnalano (con bordo e colore) la cella contenete il valore. Per semplificare il conteggio abbiamo stabilito un minimo di 8 volte, per cui quando ci sono celle bianche per più di 8 righe consecutive, nella stessa colonna, viene segnalato il problema... Un autorevole consiglio è più che apprezzato ;)) Grazie assai e buon pomeriggio, eZio
|
|
|
|
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
Salve essendo il primo giorno di vacanza, spero di aver ben interpretato il problema. la macro che segue, controlla nella tabella tutte le celle che non hanno un riempimento di colore e nel caso siano 8 o più consecutive, gli traccia un bel bordo. vedi tu se la macro è attinente al tuo problema. Code:
Sub Evidenza_max8()
Application.ScreenUpdating = False
For i = 8 To 33
uriga = Cells(Rows.Count, 8).End(xlUp).Row
For Each cl In Range(Cells(2, i), Cells(uriga, i))
x = cl.Row
If cl.Interior.ColorIndex = xlNone Then
cnt = cnt + 1
Else
If cnt >= 8 Then
Set mrange = Cells(cl.Row - cnt, i).Resize(cnt, 1)
With mrange
.Borders.Weight = xlMedium
.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 >= 8 Then
Set mrange = Cells(x - (cnt - 1), i).Resize(cnt, 1)
With mrange
.Borders.Weight = xlMedium
.Borders.LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
cnt = 0
Set mrange = Nothing
End If
cnt = 0
Next i
Application.ScreenUpdating = True
End Sub
saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, come sempre con qualche decina di righe mi hai risolto un altro grattacapo di quelli seri... Ma ora a10n11 ha scritto:essendo il primo giorno di vacanza etc. GIURO che ti lascio in pace...........ahahaha A parte gli scherzi... Grazie infinite, buon pomeriggio e sopra tutto << "Buone Ferie"!! >> (tra qualche giorno mi ci tuffo anch'io!!) eZio Nota: per applicare la macro ad una tabella filtrata basta copiare in un Foglio la tabella filtrata e fare lavorare la macro in quella tabella.
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve ..causa eccesso di esposizione al sole.. mattina sul divano e per passare il tempo quanto segue: L'evidenziazione su una tabella filtrata è possibile ma non so quanto sia leggibile. ti posto il codice poi vedi tu se usarlo o meno. Code:
Sub Evidenza_max8b()
Application.ScreenUpdating = False
With Range("H2:AH" & Rows.Count).Borders
.LineStyle = xlNone
End With
For i = 8 To 33
uriga = Cells(Rows.Count, 8).End(xlUp).Row
For Each cl In Range(Cells(2, i), Cells(uriga, i)).SpecialCells(xlCellTypeVisible)
If Not ctrl Then
RRange = cl.Row
End If
x = cl.Row
If cl.Interior.ColorIndex = xlNone Then
ctrl = True
cnt = cnt + 1
Else
If cnt >= 8 Then
aaa = cl.Row
Set mrange = Cells(RRange, i).Resize(cl.Row - RRange, 1).SpecialCells(xlCellTypeVisible)
With mrange
.Select
.Borders.Weight = xlMedium
.Borders.LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Set mrange = Nothing
End If
ctrl = False
cnt = 0
End If
Next
If x = uriga And cnt >= 8 Then
Set mrange = Cells(RRange, i).Resize(x, 1).SpecialCells(xlCellTypeVisible)
With mrange
.Borders.Weight = xlMedium
.Borders.LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
ctrl = False
cnt = 0
Set mrange = Nothing
End If
cnt = 0
ctrl = False
Next i
Application.ScreenUpdating = True
End Sub
saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, a10n11 ha scritto:
..causa eccesso di esposizione al sole..
:)) ahi ahi... brutta storia, di notte non si riesce a dormire: brucia troppo!! Ho provato la 2^ macro, ma purtroppo nel contempo toglie tutti i bordi alle altre celle. A dire il vero per il mio uso specifico è assai più "pratica" l'altra, che applico in un foglio in cui ho copiato la tabella filtrata... Comunque, come sempre: ....eccellente!!Grazie e buon pomeriggio... sul divano :(( > [ma già da domani andrà molto meglio!!...] eZio.
|
|
|
Guest |
