Eliminare celle vuote in una tabella excel

Question

Avrei necessità di eliminare celle vuote in una tabella Excel in maniera tale da accodare i dati esistenti

ho usato questa routine trovata in rete:

For k = 1 To 3

Dim cl As Object

For Each cl In Range("DF2956:DL3016")

If cl.Value = "" Then

cl.Delete

End If

Next

Next

il ciclo for  .. next in testa l'ho dovuto aggiungere perché non completava il ciclo ma impiega un tempo, secondo me, eccessivo senza contare che devo posizionare, al di sotto di questa tabella, celle non vuote per evitare che la suddetta routine mi sposti i dati nelle colonne adiacenti che poi devo svuotare.

Il range è così alto perché questo è un elenco che utilizzerò in convalida dati

Questa la tabella: a sinistra ciò che ho a destra quello che vorrei ottenere

Col 1	Col 2	Col 3	Col 4	Col 5	Col 6	Col 7	Prg	Col 1	Col 2	Col 3	Col 4	Col 5	Col 6	Col 7
		c1	d1				1	A1	b1	c1	d1	e1	f1	g1
					f1		2	A2	b2	c2	d2	e2	f2	g2
A1	b1			e1			3			c3	d3	e3	f3	g3
					f2	g1	4				d4		f4	g4
				e2			5							g5
A2							6							g6
						g2	7							g7
	b2	c2					8							g8
							9							g9
							10							g10
						g3	11							g11
							12							g12
						g4	13							g13
						g5	14							g14
			d2				15							g15
		c3				g6	16
						g7	17
			d3			g8	18
							19
			d4		f3		20
							21
							22
							23
				e3			24
						g9	25
						g10	26
							27
						g11	28
							29
							30
							31
					f4		32
							33
							34
						g12	35
							36
							37
							38
							39
						g13	40
							41
							42
							43
							44
						g14	45
							46
							47
							48
						g15	49
							50
							51
							52
							53
							54
							55
							56
							57
							58
							59
							60

Answer 1

Anche se in effetti l'ordinamento porterebbe ad un ordine differente da quello in esempio

Ad es. dopo d1 si avrebbe d10. Quindi non proprio nell'ordine presente nell'esempio.

Answer 2

Ciao,

dal tuo esempio sembra che i dati siano ordinati, o comunque che debbano risultare ordinati.

Se fosse così in luogo della cancellazione delle celle perché non pensare ad effettaure un ordinamento per ogni colonna dell'intervallo?

In questo modo credo che il tempo di esecuzione sarebbe molto più veloce.

Naturalmente solo se in effetti i dati debbano/possano essere ordinati.

ciao

Answer 3

Ciao Mykia55,

Provato ma mi risponde errore run time '1004'

non è stata trovata alcuna cella

ho integrato il tuo codice in questo:

Public Sub Tester()

Sheets("1").Unprotect Password:="!Qazxsw2"

    Dim Miorange As Range

    Dim cel As Range

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, Rng2 As Range, rCell As Range

    Dim CalcMode As Long

    Set Miorange = Range("CX3017:DW3100")

    For Each cel In Miorange

        If cel.Value = "" Then cel.Value = 0

     Next cel

Range("cx2956:dd3016").Select 'celle da copiare

Selection.Copy

Sheets("1").Select ' foglio dove copiare

Range("df2956:dl3016").Select 'celle dove copiare

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Const sFoglio As String = "1"

    Const sIntervallo As String = "DF2956:DL3016"

Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range(sIntervallo)

    Set Rng2 = Rng.SpecialCells(xlCellTypeBlanks)  'qua si ferma il debug

If Not Rng2 Is Nothing Then

        On Error GoTo XIT

        With Application

            CalcMode = .Calculation

            .Calculation = xlCalculationManual

            .ScreenUpdating = False

        End With

        Rng2.Delete Shift:=xlUp

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

Il mio codice funzionerebbe senza problemi purchè si siano delle celle vuote nell'intervallo DF2956:DL3016. Con  questo codice, per evitare un messaggio di errore se non ci dovessero essere celle vuote, sostituisci:

Set Rng2 = Rng.SpecialCells(xlCellTypeBlanks)  'qua si ferma il debug

If Not Rng2 Is Nothing Then

        On Error GoTo XIT

con:         

       On Error GoTo XIT

      Set Rng2 = Rng.SpecialCells(xlCellTypeBlanks)  'qua si ferma il debug

       If Not Rng2 Is Nothing Then

Tornando al tuo adattamento del mio codice, va notato che le istruzioni

 Set Miorange = Range("CX3017:DW3100")

    For Each cel In Miorange

        If cel.Value = "" Then cel.Value = 0

     Next cel

sostitiurebbe le celle vuote con celle contenenti il valore 0. Pertanto, riscontreresti il l'errore indicato oppure, se dovessi modificare il mio codice come suggerito, il codice non fornirebbe errori ma non farebbe niente poichè non troverebbe alcuna cella vuota da spostare.

===

Regards,

Norman

Answer 4

Provato ma mi risponde errore run time '1004'

non è stata trovata alcuna cella

ho integrato il tuo codice in questo:

Public Sub Tester()

Sheets("1").Unprotect Password:="!Qazxsw2"

    Dim Miorange As Range

    Dim cel As Range

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, Rng2 As Range, rCell As Range

    Dim CalcMode As Long

    Set Miorange = Range("CX3017:DW3100")

    For Each cel In Miorange

        If cel.Value = "" Then cel.Value = 0

     Next cel

Range("cx2956:dd3016").Select 'celle da copiare

Selection.Copy

Sheets("1").Select ' foglio dove copiare

Range("df2956:dl3016").Select 'celle dove copiare

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Const sFoglio As String = "1"

    Const sIntervallo As String = "DF2956:DL3016"

Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range(sIntervallo)

    Set Rng2 = Rng.SpecialCells(xlCellTypeBlanks)  'qua si ferma il debug

If Not Rng2 Is Nothing Then

        On Error GoTo XIT

        With Application

            CalcMode = .Calculation

            .Calculation = xlCalculationManual

            .ScreenUpdating = False

        End With

        Rng2.Delete Shift:=xlUp

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

Answer 5

Ciao Mykia55,

Avrei necessità di eliminare celle vuote in una tabella Excel in maniera tale da accodare i dati esistenti

ho usato questa routine trovata in rete:

For k = 1 To 3

Dim cl As Object

For Each cl In Range("DF2956:DL3016")

If cl.Value = "" Then

cl.Delete

End If

Next

Next

il ciclo for  .. next in testa l'ho dovuto aggiungere perché non completava il ciclo ma impiega un tempo, secondo me, eccessivo senza contare che devo posizionare, al di sotto di questa tabella, celle non vuote per evitare che la suddetta routine mi sposti i dati nelle colonne adiacenti che poi devo svuotare.

Il range è così alto perché questo è un elenco che utilizzerò in convalida dati

Questa la tabella: a sinistra ciò che ho a destra quello che vorrei ottenere

[...]

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, Rng2 As Range

    Dim CalcMode As Long

    Const sFoglio As String = "Foglio1"                                  '<<=== Modifica

    Const sIntervallo As String = "DF2956:DL3016"              '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range(sIntervallo)

    Set Rng2 = Rng.SpecialCells(xlCellTypeBlanks)

    If Not Rng2 Is Nothing Then

        On Error GoTo XIT

        With Application

            CalcMode = .Calculation

            .Calculation = xlCalculationManual

            .ScreenUpdating = False

        End With

        Rng2.Delete Shift:=xlUp

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

'<<=========

===

Regards,

Norman