MS Excel

Zdravim vsechny potreboval bych momost s jednim makrem ktere by umelo nasledujici. Ve slouoci H je seznam materialu a ve sloupci I se knim dotahuje text. Pokud text skonci err tak bych potreboval dany material ve slpupci H pouze vymazat (delete). Pokud nekdo elegantne dokaze budu rad. Děkuji moc viz priloha

Zaslat odpověď >

elninoslov(20.1.2019 22:51)#042476

Sub Vymaz_Err()
Dim PrvniRadekDat As Long, PoslRadekDat As Long, Radku As Long, SloupecDat As Integer, Data(), i As Long, rngErr As Range

PrvniRadekDat = 5
SloupecDat = 9

With ThisWorkbook.Worksheets("DATA")
PoslRadekDat = .Cells(.Rows.Count, SloupecDat).End(xlUp).Row
If PoslRadekDat < PrvniRadekDat Then MsgBox "Žádná data.", vbInformation: Exit Sub
Radku = PoslRadekDat - PrvniRadekDat + 1
ReDim Data(1 To Radku, 1 To 1)
If Radku = 1 Then Data(1, 1) = .Cells(PrvniRadekDat, SloupecDat).Value Else Data = .Cells(PrvniRadekDat, SloupecDat).Resize(Radku).Value
For i = 1 To Radku
If Data(i, 1) = "err" Then
If rngErr Is Nothing Then Set rngErr = .Cells(PrvniRadekDat + i - 1, SloupecDat - 1) Else Set rngErr = Union(rngErr, .Cells(PrvniRadekDat + i - 1, SloupecDat - 1))
End If
Next i
If Not rngErr Is Nothing Then rngErr.ClearContents
End With
End Sub

Příloha: zip

42476_mazani-err.zip (17kB, staženo 31x)

citovat

Merlin99(21.1.2019 7:56)#042478

elninoslov: Díky moc je to dokonalé :))) skvělá práce. DÍKYcitovat

Stalker(23.1.2019 18:26)#042527

Tak trochu zneužiji toto vlákno.
Měl sem vymyšlené řešení pomocí pole, než sem však stačil zareagovat (byl sem v práci na mobilu) elnino poskytl řešení.

Nedalo mi to a dneska sem vyplodil dva kódy, a tady je vlastně můj dotaz. Primárně se týká druhého kódu (Vymaz_Err_3). Vidíte v něm nějakou zásadní slabinu nebo chybu proč takhle né?
Má domněnka je, že by měl být v případě většího počtu dat rychlejší - počet průchodů cyklu bude roven počtu (chyb) výskytu hodnoty err.

Autor dotazu může případně otestovat na větším počtu položek.

PS: Pokud by někdo věděl jak do uvedeného kódu dostat převod řetězce na malá písmena (při porovnání) stejně jako je tomu v Vymaz_Err_2 budu jen rád.

Díky

Příloha: zip

42527_mazani-err.zip (19kB, staženo 27x)

citovat

elninoslov(24.1.2019 6:45)#042529

Použitie WorksheetFunction.Match alebo Application.Match je rýchlejšie iba za určitých okolností. Ak je málo výskytov zhody a veľa dát. Ak bude výskytov viac, tak prejdenie poľa bude podľa mňa rýchlejšie. Tam môžete urobiť cez StrComp() porovnanie na NotCaseSensitive. Ak bude dnes čas a chuť porovnám ... :)citovat

elninoslov(24.1.2019 16:51)#042542

Urobil som nejaké úpravy a porovnávaciu procedúru. Ak to robím správne, tak najlepšie vychádza to prvé. Stúpajúcim počtom sa rozdiely vyrovnávajú. Ale nejako sa mi to nezdá, ak máte niekto overenejší nápad ako otestovať dĺžku týchto konkrétnych proc, tak ... mne sa už nece.

EDIT: A zabudli sme na najjednoduchšiu vec. Ak by sa tam nechali normálne chyby a nie "err", tak stačí toto:
On Error Resume Next
List1.Cells(5, 12).Resize(10004).SpecialCells(xlCellTypeFormulas, xlErrors).Offset(0, -1).ClearContents
On Error GoTo 0

Příloha: zip

42542_mazani-err.zip (301kB, staženo 28x)

citovat

Stalker(25.1.2019 7:14)#042553

Teda chlape, ty ses do toho pustil. Ten Tvůj kód (první) vychází nejlépe. Ten zbytek se tak nějak mezi sebou mele, i když by se M$ za tem Timer ve VBA měl stydět. Pokud spustím test ještě jednou výsledky se absolutně změní a u některých procedur vrací 0,0000 ms.

Hlavní je, že myslet znamená h.... vědět. A to co sem si původně naivně myslel, že bude rychlejší, tak není.

Díky za čas, který si tomu věnoval.
Jo a s tím editem máš naprostou pravdu, v jednoduchosti je síla.

citovat

elninoslov(25.1.2019 8:32)#042554

Na ten časovač by sa dala použiť API, deklarácia možno takto +- autobus (netestoval som na inom ako E2019 x64 + W10 x64)
#If Win64 Then
#If VBA7 Then
Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr
#Else
Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongLong
#End If
Dim TimeMS As LongLong
#Else
Declare Function GetTickCount Lib "kernel32" () As Long
Dim TimeMS As Long
#End If
TimeMS = GetTickCount
.. kód ...
milisekundy=GetTickCount - TimeMS
ale ten tiež vracia nepravidelné hodnoty, čo je spôsobené "optimalizovaným" časovačom Windows, ktorý nieje pravidelný, a má rozptyl 10-16 ms. Vraj kvôli optimalizácii spotreby. Nikdy som sa po tom nepídil, tak neviem, či sa musí trafiť do okna 10-16 inak je 0 alebo predošlý Tick, alebo ako to je. Nepotrebujem to :)
Keď to spustím v testovacej proc, tak dáva pri najrýchlejšej niekedy 0, niekedy 10. Keď samostatne tak 170. Nedá sa na to spoľahnúť. Sú aj iné API. Ale kašle na to pes, stačí pocitovo každé tlačítko zvlášť.

Aj tak by bolo najjednoduchšie a naj user-friendly to SpecialCells...
Hawkcitovat

Téma: VBA mazani dat s podminou

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje