Excel posun řádků do prázdného řádku Vyřešeno

[Diesels]

Dobrý večer,

Potřebuji hodnoty v tabulce seřadit, respektive posunout řádek do prázdného řádku. Tzn. prázdný řádek by byl na konci tabulky. Viz. příložený soubor. Lámu si s tím hlavu už nějakou chvíli. Vím, že musím použít (xlup)..ale nějak se mi to nedaří...

[Reklama]

[Azuzula]

Zdravím,
nestačilo by jednoduše formátovat tu potřebnou oblast jako tabulku? Podle koncovky souboru máte Excel 2007 nebo 2010, takže označte si tu oblast a na kartě "Domů" ikona "Formátovat jako tabulku". Potom už jde seřadit hodnoty podle abecedy nebo podle určeného filtru a zbytek listu zůstane nedotčený.

[Diesels]

Vyzkouším a dám vědět..

[Diesels]

Tak jsem to vyzkoušel a není to to co potřebuji....

[Azuzula]

V tom případě si neumím představit co vlastně potřebujete.

[Diesels]

Viz. příklad.
Dejme tomu, že oblast, která je v příkladu bude zcela vyplněna daty. Pomocí jednoho makra (to makro na smazání nepotřebuji) se smažou data na jednom řádku a zbude tam prázdný řádek.
Tzn. data budou nad tímto řádkem a taky pod. A právě ty data pod chci, aby se posunula do volného řádku, respektive, aby tam nezůstal volný řádek uprostřed tabulky. Řesí se to pomocí .End(xlUp).Offset(1, 0).
Zkoušel jsem to zakomponovat do mého makra, ale neúspěšně. Proto se obracím zde.

A Data
B Data
C prázdný řádek
D Data
E Data

a potřebuji to upravit na tohle

A Data
B Data
C Data
D Data
E prázdný řádek

[cmuch]

Čím bude dáno, který řádek se nemá posunout ?

[Azuzula]

Tak jsem Vám napsala makro na posun řádků.
První sloupec musí být vždy vyplněn, když najde jeden prázdný řádek a za ním data, tak data přesune nahoru. Dva prázdné řádky na konci ukončí makro. Je to bez ošetření chybových stavů. Posouvá jen data, bez formátování. Aktuálně posouvá jen 4 buňky v řádku, pokud chcete víc, tak stačí změnit rozsah ve čtyřech řádcích označených hvězdičkou.

Kód: Vybrat vše

Sub posun()
Sub posun()
Dim a As Integer, radek0, radek1
Application.ScreenUpdating = False
a = 1
zacatek:
    If Cells(a, 1) = "" Then
        If Cells(a + 1, 1) = "" Then GoTo konec
        radek0 = Range("A" & a & ": D" & a) '*
        radek1 = Range("A" & a + 1 & ": D" & a + 1) '*
        Range("A" & a & ": D" & a) = radek1 '*
        Range("A" & a + 1 & ": D" & a + 1) = radek0 '*
    End If
a = a + 1
GoTo zacatek
konec:
Application.ScreenUpdating = True
End Sub


[Diesels]

Přesně takhle jsem to chtěl, jen ještě dodatek.
Platí to pro celý sloupec A až D. Mohla by jsi to upravit jen na určitou oblast. Tedy aby se řádky posouvaly jen do určitého řádku a ne v celém sloupci A až D ?

[cmuch]

Šlo by třeba místo tohoto If Cells(a, 1) = "" Then dát toto If Cells(x, 1) = "" Then kde x bude posledni řádek po který se to má provést.

[Azuzula]

Omezit se to dá přidáním podmínky za počítadlo, takhle to je max 100 řádků

Kód: Vybrat vše

if a = 100 then
       Application.ScreenUpdating = True
       exit sub
end if

celé makro

Kód: Vybrat vše

Sub posun()
Dim a As Integer, radek0, radek1
Application.ScreenUpdating = False
a = 1
zacatek:
    If Cells(a, 1) = "" Then
        If Cells(a + 1, 1) = "" Then GoTo konec
        radek0 = Range("A" & a & ": D" & a) '*
        radek1 = Range("A" & a + 1 & ": D" & a + 1) '*
        Range("A" & a & ": D" & a) = radek1 '*
        Range("A" & a + 1 & ": D" & a + 1) = radek0 '*
    End If
a = a + 1
if a = 100 then
   Application.ScreenUpdating = True
   exit sub
end if
GoTo zacatek
konec:
Application.ScreenUpdating = True
End Sub

[Diesels]

Tak to je paráda, přesně tohle jsem potřeboval. ..Super. Děkuji Vám za čas strávený nad tímto problémem, tzn. za pomoc. A do Nového roku přeji vše nej...