Pro informace o výuce Excelu klikněte zde
Dotaz:
| Ahoj nemůžu přijít na nic, co by mi pomohlo. Office 2000 5.5 mil. buněk = cca 63-65 tis. řádků sloupců A-CQ (95 sloupců)Jakákoliv buňka z těch 5.5 milionů může mít jakýkoliv netisknutelný znak ve svém obsahu (typicky se jedná o znak Cr – tedy nový řádek) Může to být klidně jen jedna, ale taky klidně všechny. Zkusil jsem klasický cyklus přes všechny cykly a odstranění všech znaků od 1 do 31Cyklus pro 1 000 řádků a 89 sloupců = cca 980 ti.s buněk trval necelých 40 sec, kdybych počítal 60 sec na 1 000 řádků x 65 = 65 min Brrrrrrrr Zkusil jsem select celé oblasti a hromadný replace, ale nešlo mi to. |
Vytvořil jsem oblast 1000 řádků a 100 sloupců (tj. 100 000 buněk) a do každé buňky v oblasti jsem vložit sedm znaků, z toho tři netisknutelné.
1. Můžeme zkusit použít metodu Replace (Nahradit)
Sub NahradNetiskZnakyMetodaReplace()
Dim rng As Range, cell As Range
Dim cas As Date, i As Integer
On Error Resume Next
'Vybereme z použité oblasti jenom tu oblast, která obsahuje textové konstanty
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
If rng Is Nothing Then
MsgBox "Nenazelena žádná oblast obsahující text!", vbCritical
Else
cas = Timer
'Vypnutí překreslování obrazovky a přepočtu
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'Procházíme postupně oblast a znaky 3 až 31 nahrazujeme (odstraňujeme)
For i = 3 To 31
rng.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart
Next i
Set rng = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Hotovo za: " & Format(Timer - cas, "0.0"), vbInformation
End If
End Sub
Doba trvání na mém počítači: 211 s
2. Zkusíme oblast procházet a nahrazovat netisknutelné znaky pomocí vlastní funkce
Sub NahradNetiskZnaky() Dim rng As Range, cell As Range Dim cas As Date On Error Resume Next 'Vybereme z použité oblasti jenom tu oblast, která obsahuje textové konstanty Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues) If rng Is Nothing Then MsgBox "Nenazelena žádná oblast obsahující text!", vbCritical Else cas = Timer 'Vypnutí překreslování obrazovky a přepočtu With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With 'Postupně procházíme celou oblast a voláme funkci na odstranění netisk. znaků For Each cell In rng cell = RJOdstranitNeTisknutelneZnaky(cell.Value) Next cell Set rng = Nothing With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With MsgBox "Hotovo za: " & Format(Timer - cas, "0.0"), vbInformation End If End Sub Function RJOdstranitNeTisknutelneZnaky(Text As String) As String 'Odstraní netisknutelné znaky z textu Dim i As Integer Dim iDelka As Integer Dim sZnak As String Dim sNew As String iDelka = Len(Text) sNew = "" For i = 1 To iDelka sZnak = Mid(Text, i, 1) If Asc(sZnak) > 32 Then sNew = sNew & sZnak Next i RJOdstranitNeTisknutelneZnaky = sNew End Function
Doba trvání na mém počítači: 77 s
3. Celou použitou oblast vložíme do pole, pole pročistíme od netisknutelných znaků vestavěnou funkcí Excelu Clean a následně vložíme pole do oblasti
Sub NahraditArrayClean() Dim a Dim r As Long, s As Long Dim cas As Date cas = Timer 'Načtení oblasti do dvourozměrného pole a = ActiveSheet.UsedRange 'Postupné procházení pole a odstranění netisknutelných znaků For r = 1 To UBound(a, 1) For s = 1 To UBound(a, 2) 'zde použijeme vestavěnou funkci Excelu Clean (Vyčistit) 'místo vlastní funkce RJOdstranitNeTisknutelneZnaky 'ohledně rychlosti jsou oba dva způsoby podobné a(r, s) = Application.WorksheetFunction.Clean(a(r, s)) Next s Next r 'Načtení pole do oblasti ActiveSheet.UsedRange = a MsgBox "Hotovo za: " & Format(Timer - cas, "0.0"), vbInformation End Sub
Doba trvání na mém počítači: 1,9 s , tzn. tento způsob je více než 200x rychlejší než první způsob a 40x rychlejší než druhý.
Zhodnocení:
Nejrychlejší je jednoznačně třetí způsob (i bez vypnutí překreslování obrazovky a přepnutí ručního přepočtu). A důvod? U prvních dvou způsobů se zapisovaly upravené hodnoty 100 000 krát do buněk, ale ve třetím případu jen jednou. Excel totiž zapisuje hodnoty do oblasti mnohem pomaleji, než je čte. Proto, pokud potřebuje vkládat velké bloky hodnot do listu, vyhněte se zapisování v cyklu a použijte pole.
Pozn.:
U prvních dvou způsobů jsem vybral oblast pomocí SpecialCells(xlCellTypeConstants, xlTextValues), tento způsob vybere jen ty buňky, které obsahují textové konstanty (vynechá prázdné buňky, buňky obsahující vzorce i konstanty obsahující čísla apod.) Tzn. pokud by použitá oblast UsedRange ze 100 000 buněk obsahovala jen určitou část buněk s textovou konstantou, doba výpočtu by se poměrově zkrátila.