PER ELIMINARE COLONNE

[giorgioa]

Salve

un aiuto di percorso
dovrei fare un ordinamento di dati a sx
per l'ordinamento semplice me lo fa il registratore di macro
in base alla riga.
Non problem
rigo 1 da cb a fw ha una numerazione
Invece devo fare un ordinamento dati se la colonna da rigo 4 fino a rigo 304 non ha niente
dovrei eliminare tutta la colonna in modo tate che il tutto dx venga spostato a sx
mi importerebbe sapere la colonna come la chiamo se fosse una cella cells

???

[giorgioa]

sto cercando una soluzione e cioè che in rigo 3 se ho zero elimino la colonna

solo che aiutino che non ho afferrato: range("cb4:cb304) da tradurre in cells

cells(2+i,79+j).value =Application.WorksheetFunction.CountA(Range(Cells(3 + i, 79 + j), Cells(i, 304 + j)))

[Anthony47]

Questo codice?

Codice: Seleziona tutto

Sub CutCols()
Dim StartCol As String, EndCol As String

StartCol = "FW"
EndCol = "CB"

For I = Cells(1, StartCol).Column To Cells(1, EndCol).Column Step -1
    If Application.WorksheetFunction.CountA(Cells(4, I).Resize(300, 1)) = 0 Then
        Cells(4, I).EntireColumn.Delete
    End If
Next I
End Sub


Avendo dichiarato le colonne in cui guardare, poi nel ciclo uso Resize(300,1) per "allungare" l'intervallo da usare per il CountA
Se l'intervallo e' vuoto quella colonna viene eliminata

[giorgioa]

Ok oltre per eliminare la colonna non ci mettevo il delete
oltre che mi mancava tutto.

RISOLTO

Grazie

[giorgioa]

salve Anthony

per startcol intendi la colonna di partenza che se vuota viene eliminata
per endcol la fine

ho dimensionato la i con long

non elimina niente

vorrei farti presente che la riga 1 ha la numerazione da 1 a 90 che se vuota a partire da rigo 4 se vuota eliminare tutta la riga

[giorgioa]

volevo dire elimina tutta la colonna e non riga

[Anthony47]

per startcol intendi la colonna di partenza che se vuota viene eliminata
per endcol la fine

E' esatto, ma avrei dovuto scrivere che la macro deve cominciare dall'ultima colonna (cioe' lavora all'indietro); quindi StartCol deve contenere la colonna piu' a destra ed EndCol la colonna più a sinistra)

Quindi riprova con questa ulteriore informazione

[giorgioa]

Salve

visto la lettura dei start ed End ho pensato anche alla partenza dalla fine
il fatto è che io sono andato a letto sul tardi poi sul presto ho trovato che stava
ancora lavorando ed essendo in debito con le ore di straordinario
ho pensato.. solo che con questa; accettala, non mi si chiude cioè
la macro si ferma al penultimo rigo di codice
NON ti spaventare ma il lavoro me lo fa in meno di 1/2 minuto

perche non chiude la macro?
ecco la bestia

Sub Macro1()
Dim sh1 As Worksheet
Dim i As Long, j As Long
Set sh1 = Sheets("Ruote")
i = sh1.Cells(Rows.Count, 3).End(xlUp).Row
sh1.Cells(2, "gb").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[302]C)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:CL1"), Type:= _
xlFillDefault
ActiveCell.Range("A1:CL1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

For i = 1 To i
For j = 1 To 90
If Cells(1 + i, 183 + j).Value = 0 Then
Cells(1, 183 + j).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Range("A1:CK304").Cut Destination:=ActiveCell.Range( _
"A1:CK304")
ActiveCell.Range("A1:CK304").Select
End If
Next j
Next i
End Sub
. Fa che ho stabilito se la colonna conta o zero in rigo 2 (poi lo faccio con application.Worksheetfunction..
quando trova zero salgo la cella 1 successiva e seleziono tutta la parte dx e la trascino a sx sulla colonna che ha zero
e la incollo.

[Anthony47]

Non capisco come fai a determinare che "la macro si ferma al penultimo rigo di codice", che dovrebbe corrispondere all'istruzione Next I

Il codice è valido se il numero di righe di dati da gestire e' abbastanza contenuto (300 è abbondantemente "abbastanza contenuto"); ma e' sempre piu' lento che non il "Delete Colonna"
Inoltre mi sono permesso di aggiungere dei commenti al tuo codice, evidenziando numerose istruzioni superflue che quindi possono essere eliminate senza problemi; sono quelle dove il commento (la parte dopo l'apostrofo) comincia con *. Secondo me se cancelli dovresti migliorare la velocità di esecuzione.
Il codice commentato:

Codice: Seleziona tutto

Sub Macro1()
Dim sh1 As Worksheet
Dim i As Long, j As Long
Set sh1 = Sheets("Ruote")
i = sh1.Cells(Rows.Count, 3).End(xlUp).Row          '* Se non lo usi, inutile calcolarlo
sh1.Cells(2, "gb").Select                           'Funziona solo se sh1 e' già selezionato
ActiveCell.Select                                   '* E' già selezionata, inutile
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[302]C)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:CL1"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:CL1").Select               '* Non e' necessario
    Selection.Copy                                  '* idem
    Selection.PasteSpecial Paste:=xlPasteValues     '* idem
    Application.CutCopyMode = False                 '* Non necessario se non fai Copy
   
For i = 1 To i                                      'Così fa solo 1 giro, quindi perchè impostare un loop??
    For j = 1 To 90
        If Cells(1 + i, 183 + j).Value = 0 Then         'Se abolisci For I=1 to i allora usa 2 invece di 1+i
            Cells(1, 183 + j).Select
            Range(Selection, Selection.End(xlToRight)).Select  '* Queste istruzioni dovevano servire a copiare tutte (tutte? forse) le..
            Range(Selection, Selection.End(xlDown)).Select     '* .. colonne a destra dell'attuale, copiarle e spostarle a sx,..
            Range(Selection, Selection.End(xlDown)).Select     '* .. simulando elimina colonna
            Range(Selection, Selection.End(xlDown)).Select     '*
            Selection.Copy                                     '*
            Application.CutCopyMode = False                    '*
            'Ma ti sei accorto che non riuscivi a essere certo di selezionarle tutte e hai saggiamente ripiegato sulle seguenti
            '  istruzioni. Allora ELIMINA il blocco precedente!
            ActiveCell.Offset(0, 1).Range("A1:CK304").Cut Destination:=ActiveCell.Range( _
                "A1:CK304")
            ActiveCell.Range("A1:CK304").Select
        End If
    Next j
Next i                                              'Poichè il Fori=1 to i e' inutile, se togli il For toglierai anche il Next
End Sub


[giorgioa]

Salve


e WOW