< návrat zpět
MS Excel
Téma: Zrychlení makra na seřazení dat 
Zaslal/a Johny85 1.2.2013 13:23
Dobrý den,
potřebuji makrem srovnat velké množství dat podle prvního sloupce a následně podle druhého sloupce. Srovnání funguje, ale srovnávání vždy trvá neuvěřitelně dlouho (až několik minut) nevíte prosím nějaký jednodušší a hlavně rychlejší způsob srovnávání velkého množství dat? Možná dělám někde chybu... děkuji a posílám používané makro:
'aktivuji list deník
Sheets("Deník").Activate
Rows("1:6000").Select
Selection.EntireRow.Hidden = False
Columns("B:E").Select
ActiveWorkbook.Worksheets("Deník").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Deník").Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Deník").Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Deník").Sort
.SetRange Range("B1:E6000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Uzamčeno - nelze přidávat nové příspěvky.
AL(1.2.2013 13:48)#011328
Skús to nahradiť nasledujúcim:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Deník").Activate
Rows("1:6000").EntireRow.Hidden = False
Columns("B:E").Select
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B1:E6000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
mám ale podozrenie, že uvedeným to nebude, i to pôvodné makro beží u mňa odhadom cca 2 sekundy
citovatJohny85(1.2.2013 14:02)#011329 Děkuji moc, zjistil jsem, že to opravdu není makrem pro srovnání, ale tímto, které má skrýt řádky, které něco neobsahují...respektive jejich první funkce - spočítání řádků, když ji umažu, vše funguje, jen nevím jak ji nahradit...
'spočítám, kolik řádků má list
radku = ActiveSheet.UsedRange.Rows.Count
'hledám v každém řádku postupně, začínám druhým řádkem
'i počítá řádek ..
For i = 2 To radku
'jestliže v řádku není buňka B prázdná a současně buňka C je prázná ....
If Not IsEmpty(Range("D" & i)) Then
'řádek skryji
Rows(i).EntireRow.Hidden = False
End If
'i se zvyšuje o jedničku dokud nedosáhne počtu řádků
Next i
'aktivuji list deník
Sheets("Deník").Activate
'spočítám, kolik řádků má list
radku = ActiveSheet.UsedRange.Rows.Count
'hledám v každém řádku postupně, začínám druhým řádkem
'i počítá řádek ..
For i = 2 To radku
'jestliže v řádku není buňka B prázdná a současně buňka C je prázná ....
If Not IsEmpty(Range("B" & i)) And IsEmpty(Range("D" & i)) Then
'řádek skryji
Rows(i).EntireRow.Hidden = True
End If
'i se zvyšuje o jedničku dokud nedosáhne počtu řádků
Next icitovat AL(1.2.2013 14:27)#011331 Skús dať na začiatok
application.screenupdating=false
a na koniec
application.screenupdating=true
citovat eLCHa(2.2.2013 12:53)#011341 
Jenom technicka poznamka. Pokud chcete skryvat vice radku, nedelejte to po jednom, ale najednou.
viz
http://wall.cz/index.php?m=topic&id=10711#post-10712citovatJohny85(6.2.2013 9:52)#011418 Prima, už to funguje, děkuju moc
citovat
RSS nejnovější články