• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Drobná úprava macra pro seřazení

Zaslal/a fostercz 3.2.2013 22:44

Zdravim opět vás prosím o začátečnickou radu

Mám macro

Sub Makro1()

ActiveWorkbook.Worksheets("Hlavní stránka").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hlavní stránka").Sort.SortFields.Add Key:=Range("E1:W1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,45+1.,45+2.,45+3.,45+4.,45+5.,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,90+1.,90+2.,90+3.,90+4.,90+5.,90+6.,90+7.,90+8.,90+9.,90+10.," _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hlavní stránka").Sort
.SetRange Range("E1:W1")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End Sub



Tohle správně seřadí rádek 1.
Ale v tomhle sylu potřebuju seřadit dalších 4000 řádků.
Tedy seřadit 1 až 4000 řádek a buňky od sloupce E do W z levadoprava.

Děkuji Vám za každou sekundu mně věnovanou.

Uzamčeno - nelze přidávat nové příspěvky.

---

Opičák(3.2.2013 23:03)#011366

Sub Makro1()
Dim oblast As String
For radek = 1 To 4000
oblast = "E" & radek & ":W" & radek
ActiveWorkbook.Worksheets("Hlavní stránka").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hlavní stránka").Sort.SortFields.Add Key:=Range(oblast), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,45+1.,45+2.,45+3.,45+4.,45+5.,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,90+1.,90+2.,90+3.,90+4.,90+5.,90+6.,90+7.,90+8.,90+9.,90+10.," _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hlavní stránka").Sort
.SetRange Range(oblast)
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Next radek
End Subcitovat

fostercz(4.2.2013 8:20)#011368

moc děkuju citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse