[es] - [Excel] da li neko ima makro za brisanje praznih celija u nizu

anakin14
Milosevic Dejan
Kragujevac

Član broj: 73683
Poruke: 456
*.dynamic.sbb.co.yu.

Profil

[Excel] da li neko ima makro za brisanje praznih celija u nizu

^{15.08.2007. u 20:49}

da li neko ima makro za brisanje braznih celija u nizu tako da niz bude spojen a ne razdvojen praznim celijama?

^{15.08.2007. u 20:49}

3okc
Novi Beograd

Moderator
Član broj: 811
Poruke: 199
212.200.177.*

Profil

Re: [Excel] da li neko ima makro za brisanje praznih celija u nizu

^{16.08.2007. u 09:10}

Evo, imam ja makro - koji ti je potpuno nepotreban, to isto se može postići i bez makroa. Ako lista već nema Auto Filter (malo verovatno), onda ga prvo kreiraš. Potom, filtriraš kolonu sa praznim ćelijama, opcija (Blanks), i onda samo selektuješ čitave redove pa DELETE. Na kraju poništiš filter da ti prikaže ostatak liste. Mnogo jednostavnije.

A makro:

Code:

    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^'
    '^        Delete entire row arbitrary to blank cells     ^'
    '^        in given column downward from Selection        ^'
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^'
    '^        elitesecurity.org, Beograd, Avgust 2007.       ^'
    '^                                                       ^'
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^'

Sub DeleteEntireRowInGivenColumn()
Dim rngSelection As Range

    Set rngSelection = ActiveCell
    Application.ScreenUpdating = False
    Do
        'Activate next blank cell down
        ActiveCell.Offset(1, 0).Select
        Do While Not IsEmpty(ActiveCell)
            ActiveCell.Offset(1, 0).Select
        Loop
        'Select blanks downward
        Range(ActiveCell, ActiveCell.End(xlDown)).Select
        Selection.Resize(Selection.Rows.Count - 1, 1).Select
        'Delete Selection
        Selection.EntireRow.Delete
        'Unselect range of cells
        ActiveCell.Select
    Loop Until ActiveCell.End(xlDown).Row = ActiveSheet.Rows.Count

    rngSelection.Select
    Set rngSelection = Nothing
    Application.ScreenUpdating = True
End Sub

=3ok=

^{16.08.2007. u 09:10}