< návrat zpět

MS Excel


Téma: setřídění vzestupně-sestupně rss

Zaslal/a 19.10.2018 18:56

dobrý den, dotaz na setřídění buněk. potřebuju setřídit buňky dle datumu v dané buňce "L3,L12,L21"a další. , ale s tím že na tento datum je vázaná oblast buněk"a1:m8,a10:m17,a19:a26" včetně obrázku. viz příklad v souboru, takhle to potřebuju setřídit cca 300 záznamů. děkuji za radu

Příloha: zip41693_ukazka.zip (18kB, staženo 25x)
Zaslat odpověď >

#041696
elninoslov
Možno aj takto, ale pozor, používa sa rovnako veľká oblasť vpravo, kde sa premiestnia zoradené oblasti, a pôvodné stĺpce (už bez oblastí) sa celé zmažú. Vyskúšajte.

Sub ZoradSkupiny()
Dim Col As Collection, Riadkov As Long, Skupin As Long, i As Long, c, Datum As Date, Dat(), Z As Boolean, OldRng As String

Set Col = New Collection
With ThisWorkbook.ActiveSheet
Riadkov = .Cells(Rows.Count, 2).End(xlUp).Row + 2
Skupin = Riadkov \ 9
If Riadkov / 9 <> Skupin Then MsgBox "Oblasti niesú rovnomerné! Koniec.": Exit Sub
ReDim Dat(1 To Riadkov, 1 To 1)
Dat = .Cells(1, 12).Resize(Riadkov).Value

For i = 1 To Skupin
Datum = Dat((i - 1) * 9 + 3, 1)
Z = False
If Col.Count > 0 Then
For Each c In Col
If c(0) > Datum Then Col.Add Array(Datum, i), Before:=CStr(c(1)): Z = True: Exit For
Next c
If Z = False Then Col.Add Array(Datum, i), CStr(i)
Else
Col.Add Array(Datum, i), CStr(i)
End If
Next i

With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual: End With
OldRng = Selection.Address
.Cells(1, 1).Resize(, 13).Copy
.Cells(1, 14).Resize(, 13).PasteSpecial Paste:=xlPasteColumnWidths

Riadkov = 0
For Each c In Col
.Cells((c(1) - 1) * 9 + 1, 1).Resize(9, 13).Cut
.Cells(Riadkov * 9 + 1, 14).Resize(9, 13).Insert Shift:=xlDown
Riadkov = Riadkov + 1
Next c

.Columns(1).Resize(, 13).EntireColumn.Delete

With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic: End With
.Range(OldRng).Select
End With

Set Col = Nothing
End Sub
Příloha: zip41696_zoradenie-oblasti.zip (25kB, staženo 24x)
citovat
#041697
avatar
super skvělé, mnohokrát děkuji. funguje přesně jak potřebuju.citovat
#041698
elninoslov
Keď na to ešte tak pozerám, pridajte na koniec tohto riadku:
If Z = False Then Col.Add Array(Datum, i)
ešte ", CStr(i)", teda:
If Z = False Then Col.Add Array(Datum, i), CStr(i)citovat
#041699
avatar
OK, ještě se zeptám, pokud ty buňky nebudou začínat od řadku 1, ale od řádku 12 ? kde tohle můžu změnit nebo přidat ?citovat
#041700
elninoslov
Tu máte zmenenú verziu, nielen od 12. riadku, ale aj predpokladám potrebu uchovania tých 11 riadkov nad tým, a zároveň upravený proces zoradenia.

A čo tam chcete vyčarovať s tými ostatnými makrami ?
Příloha: zip41700_zoradenie-oblasti.zip (30kB, staženo 23x)
citovat
#041701
avatar
děkuju super, jelikož ty data jsem měl dřív nějak zapsané, chtěl jsem je dát do nového formátu, takže ty makra co jsou v souboru je ve většině pokus-omyl. vždycky něco najdu a snažím se aplikovat a i pochopit fungování, někdy se zadaří jindy ne.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09