Excel Forum

	Soluzioni Excel Domande e Risposte
		EXCELL - Evidenziare sequenza celle vuote

Pagina precedente | 1 | Pagina successiva

Vota | Stampa | Notifica email

« Discussione Precedente | Lista | Discussione Successiva »

Autore

EXCELL - Evidenziare sequenza celle vuote

Ultimo Aggiornamento: 08/11/2017 08:52

SphoenixS

Post: 1

Registrato il: 07/11/2017

Città: BERGAMO

Età: 33

Utente Junior

Excel 2016

OFFLINE

07/11/2017 15:29

00#1

[RISOLTO] - Evidenziare sequenza celle vuote

Buongiorno,
non sono molto esperto di excel, e se possibile vorrei un aiuto in merito.
Ho provato a cercare nel sito, e su Internet, ma non ho trovato la soluzione che fa al caso specifico.

In poche parole:
- ho un file Excell dove ci sono diverse colonne con circa 100 celle da compilare di volta in volta.
- In ogni colonna sono intervallate "celle con numeri" e "celle vuote".
- VORREI CHE NEL MOMENTO IN CUI SI PRESENTANO 7 CELLE VUOTE DI FILA, QUESTE VENGANO EVIDENZIATE.

il modo più semplice per fare ciò, oltre che esteticamente carino, credo sia con questi passaggi:
1) Formattazione condizionale;
2) Regole evidenziazione celle;
3) Altre regole;
4) Utilizza una formula per determinare le celle da formattare;
5) FORMATTA I VALORI PER CUI QUESTA FORMULA RESTITUISCE VERO.

Allego il file .xlsx

Ringrazio anticipatamente per l'aiuto.

P.S: Se riesce a dare un colore diverso per sequenza di 7, sequenza di 8, sequenza di 9, sarebbe perfetto.

Download (13 KB)

[Modificato da SphoenixS 08/11/2017 08:55]

locatevaresino

Post: 2.039

Registrato il: 21/03/2008

Città: LOCATE VARESINO

Età: 76

Utente Veteran

2007 / 13

OFFLINE

07/11/2017 18:49

00#2

ciao

lavoro da fare con sub() o macro

da inserire nel modulo del foglio

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:P123")) Is Nothing Then Exit Sub
On Error Resume Next
Dim r As Long, c As Long
Dim Rp As Long, Rf As Long
Range("A1:P123").Interior.ColorIndex = xlNone
For c = 1 To 16
Rp = 1
Rf = 0
For r = 1 To 123
If Cells(r, c) = "" Then
Rf = Rf + 1
Else
Rf = 0
Rp = r + 1
End If
If Rf > 6 Then Range(Cells(Rp, c), Cells(Rf + Rp - 1, c)).Interior.ColorIndex = Rf
If Rf > 55 Then Range(Cells(Rp, c), Cells(Rf + Rp - 1, c)).Interior.ColorIndex = 55 ''xlNone
Next r
Next c
End Sub

allego il tuo file in modalita' macro

PS ho visto adesso che il minimo sono 7 e non 6 modifico la sub eliminando = va modificata anche nel file allegato
riciao

Download (23 KB)

[Modificato da locatevaresino 07/11/2017 18:53]

Ciao da locate
excel 2007 / 13

SphoenixS

Post: 2

Registrato il: 07/11/2017

Città: BERGAMO

Età: 33

Utente Junior

Excel 2016

OFFLINE

07/11/2017 19:17

00#3

Re:

locatevaresino, 07/11/2017 18.49:
ciao

lavoro da fare con sub() o macro

da inserire nel modulo del foglio

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:P123")) Is Nothing Then Exit Sub
On Error Resume Next
Dim r As Long, c As Long
Dim Rp As Long, Rf As Long
Range("A1:P123").Interior.ColorIndex = xlNone
For c = 1 To 16
Rp = 1
Rf = 0
For r = 1 To 123
If Cells(r, c) = "" Then
Rf = Rf + 1
Else
Rf = 0
Rp = r + 1
End If
If Rf > 6 Then Range(Cells(Rp, c), Cells(Rf + Rp - 1, c)).Interior.ColorIndex = Rf
If Rf > 55 Then Range(Cells(Rp, c), Cells(Rf + Rp - 1, c)).Interior.ColorIndex = 55 ''xlNone
Next r
Next c
End Sub

allego il tuo file in modalita' macro

PS ho visto adesso che il minimo sono 7 e non 6 modifico la sub eliminando = va modificata anche nel file allegato
riciao

Ciao,

non saprei proprio da dove cominciare :.(

Potresti dirmi passo per passo come fare?

Allego comunque il file excel semidefinitivo (vorrei aggiungere altre colonne)

Download (46 KB)

locatevaresino

Post: 2.040

Registrato il: 21/03/2008

Città: LOCATE VARESINO

Età: 76

Utente Veteran

2007 / 13

OFFLINE

07/11/2017 23:08

00#4

ciao

come stiamo a VBA ????
spiegare questi passaggi e' un pochino problematico per chi non conosce VBA

comunque tentero' di darti delle risposte

PS NON RIPORTARE QUELLO CHE VIENE SCRITTO IN PRECEDENZA (LAVORO INUTILE)

la sub() in questione in base al tuo file postato e stata cambiata radicalmente in quanto da cella C4 a cella Xx ci sono delle formule

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:A10000")) Is Nothing Then Exit Sub ''se modifichi in colonna A:A si attiva la sub
On Error Resume Next
Application.ScreenUpdating = False
Dim r As Long, c As Long
Dim Rp As Long, Rf As Long
Dim Nriga As Long, Ncolonna As Long ''fino qui vengono indicizzate le variabili
Nriga = UsedRange.Row + UsedRange.Rows.Count - 1
Ncolonna = UsedRange.Column + UsedRange.Columns.Count - 1 ''trovo l'ultima riga e colonna occupata
Range(Cells(4, 3), Cells(Nriga, Ncolonna)).Interior.ColorIndex = xlNone ''elimino varie colorazioni
For c = 3 To Ncolonna ''qui incomincia il lavoro dei due cicli
Rp = 4 ''riga di partenza
Rf = 0 ''numero celle vuote
For r = 4 To Nriga
If Cells(r, c) = "" Then
Rf = Rf + 1 ''conto celle vuote
Else 'se trovo una cella piena porte le variabili inizio fine ai valori di partenza
Rf = 0
Rp = r + 1
End If
If Rf > 6 Then Range(Cells(Rp, c), Cells(Rf + Rp - 1, c)).Interior.ColorIndex = Rf ''coloro con i colori di excel
If Rf > 55 Then Range(Cells(Rp, c), Cells(Rf + Rp - 1, c)).Interior.ColorIndex = xlNone ''non inserisco nessun colore
Next r
Next c
Application.ScreenUpdating = True
End Sub