Odstranění netisknutelých znaků v oblasti

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.

Více dvourozměrném pole a oblasti

Napsat komentář

Vaše emailová adresa nebude zveřejněna. Vyžadované informace jsou označeny *