Vy vo Workbooks.Open(Fname) otvárate HTML dokument ? Ukážte aká je to stránka, alebo rovno ten HTML dokument. Na to treba asi skúsiť Import dát, Data z webu, PowerQuery, alebo rozklad kolekcie elementov v makre, prípadne parsovať kód html...
Makro je nahrané záznamníkom, teda je tam polka zbytočná, každopádne, ak je formát buniek Text, tak to kopíruje správne.
Načo presúvať stĺpec za iný, a potom oba doľava, keď stačí posunúť len krajný do ľava?
Raz formátujete oblasť po riadok 319, potom len po riadok 238. Určite správne ?
Kopírujete stále asi tú istú oblasť, potom netreba toľko riadkov.
Načo stále formátovať skopírované bunky, keď môžete skopírovať iba hodnoty, do vopred naformátovanej oblasti.
Ak by ste poznal názov listu, dali by sa vložiť jednoúčelovo iba vzorce s odkazom na hodnotu a previesť ich na hodnotu, bolo by to bez pomalého otvárania súboru.
...
Navrhujem "malú" zmenu makra.
Malo by fungovať aj to, ak si zmeníte to
-2
na
-ROW(A2)
-ŘÁDEK(A2)
bude to tak pochopiteľnejšie, a pri úprave Vás to skôr "pichne do oka" :)
To je ako s tým povestným hádzaním hrachu na stenu. Veď som Vám poslal prílohu s ukážkou pomocnej tabuľky. To isté Vâm radí aj lubo. A Vy stále riešite, ako sa ten vzorec dozvie čím má nasobiť... No predsa tak ako vravíme, a ako sme ukázali na prílohe. Máte tam predsa nejaký vzorec. Máte? Máte! Tak ho zmeňte tak ako som ukázal v prílohe. Je fuk na ktorom je riadku, veď je relatívny. Vždy počíta ten riadok na ktorom je.
Alebo pošlite prílohu.
Tak si na to urobte prevodnú tabuľku ako táto.
Alebo určite intervaly že ak ABS(G1-H1) bude
<0,0001 - *10000
<0,01 - *100
<0 - *10
alebo podobne.
No už chápem čo myslíte, ale nechápem podmienky, ktorými sa to má riadiť. Koľko čísel pred desatinnou čiarkou je hranica pre násobok 10000, koľko pre 100 a koľko pre 10 ? Ak poznáte intervaly, tak namiesto *10000 tak dajte *(ak podmienka, tak 10000, inak ak podmienka, tak 100, inak 10)) a vynásobí Vám to tak ako chcete.
A potrebujete čo? Nahradiť zostávajúce 10000 tou 100 a takisto asi omylom zadané 10 tiež tou 100?
Ctrl+H (Nahradiť)
Kde hľadať : Vzorce
Hľadať : ~*10000)
Nahradiť čím : *100)
obdobne s 10
Hľadať : ~*10)
Nahradiť čím : *100)
Za prvé.
Ten môj vzorec počíta správne, akurát ste ho zle aplikoval. Vzorec som posielal podľa Vášho popisu na počítanie od 2. riadku. preto je tam B2 ... B2 ... -2 ... B2
Žiadate o B2, dostanete B2, zmeníte to na A5, ale nezmeníte to -2 na -5.
Za druhé.
Ten filter máte nastavený iba po riadok 25, ostatné sa NEFILTRUJE!
Takéto rozšírenie, keď sa mažú vždy bunky o 2 a o 4 vpravo od kontrolovaného stĺpca, nieje problém. Tam kde sú vzorce, a majú tam ostať, nehovoríme, že sa zmaže ich výsledok, ale že sa skryje (!) - vzorcom. Použite na všetky dotknuté vzorcové stĺpce, ktoré majú skrývať hodnotu, podmienku IF/KDYŽ, ako bola prezentovaná ukážka v predošlej prílohe.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, RNG As Range
Set Zmena = Intersect(Target, Union(Columns(3), Columns(9), Columns(16), Columns(22)))
If Not Zmena Is Nothing Then
For Each Bunka In Zmena.Cells
If IsEmpty(Bunka) Then
If RNG Is Nothing Then Set RNG = Union(Bunka.Offset(0, 2), Bunka.Offset(0, 4)) Else Set RNG = Union(RNG, Bunka.Offset(0, 2), Bunka.Offset(0, 4))
End If
Next Bunka
If Not RNG Is Nothing Then
Application.EnableEvents = False
RNG.ClearContents
Application.EnableEvents = True
End If
End If
End Sub
Dá sa spraviť aj úplne variabilné makro, kde si v ňom zadáte do poľa parametrov kontrolované stĺpce a k nim mazané stĺpce (ľubovoľné množstvo a umiestnenie voči kontrolovanej bunke). ľahko doplniteľné a editovateľné. Ak to treba tak, písnite, možno večer to spráskam.
Zmenil som Vám vzorce, a pridal to makro. Normálne funguje.
Takže do A vkladáte hodnoty ručne, to je jasné.
B,D,F - vzorce.
1. Do C vkladáte hodnoty ručne ? Ak nie, aký je tam vzorec ?
2. Do E vkladáte hodnoty ručne ? Ak nie, aký je tam vzorec ?
3. Pri vymazaní A, nemá byť nič vidieť v C,E ?
4. Pri vymazaní A, nemá byť nič vidieť v B,D,F ?
Samozrejme to ide aj makrom a to udalosťou "Worksheet_Change" daného listu. Zvládne to aj hromadnú zmenu.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, RNG As Range
Set Zmena = Intersect(Target, Columns(1))
If Not Zmena Is Nothing Then
For Each Bunka In Zmena.Cells
If IsEmpty(Bunka) Then
If RNG Is Nothing Then Set RNG = Union(Bunka.Offset(0, 2), Bunka.Offset(0, 4)) Else Set RNG = Union(RNG, Bunka.Offset(0, 2), Bunka.Offset(0, 4))
End If
Next Bunka
If Not RNG Is Nothing Then RNG.ClearContents
End If
End Sub
Predpokladám ale rovnako ako Jirka78, že to tam ťaháte vzorcom.
Inak ako to môžete mazať medzerníkom, veď Vám to hneď hodí chybu v B, D, F. Takže musíte vidieť, že je niečo zle na takom spôsobe.
Ja čo si pamätám, tak u mňa "zlobí" schránka vo VBA a celkovo aj v Exceli už od 2013. A skúšal som všetky Exceli 2013/2016/2019 v kombináciách s Win8.1 a W10 (všetky polročné verzie od 9/2015) s aktualizáciami aj bez. Jedine čo som tuším neskúšal je Office 365. Napr. návody na API Clipboard Management vo VBA čo sú na nete nefungujú (nerozbehal som), Excel vo VBA padal pri kopírovaní celého listu do iného súboru. Ale aj bez VBA mám problém min od 2016, pri kopírovaní bunky Ctrl+C a prilepení inde Ctrl+V nepravideľne vypisuje chybu "Vyskytol sa problém so schránkou ..." a Excel stratí kurzor. A pod... Nie som jediný čo má problém so schránkou. Ale zvykol som si častejšie sejvovať, a nemám chuť zisťovať "jádro pudla".
Osobne vysvetliť neviem.
Skúste 32-bit verziu inštalácie.
To je jednoduché. Sú použité 3 funkcie SumIf, VLookup, CountIf. Ak sa pozriete na potrebnú skladbu parametrov týchto funkcií, tak zistíte prečo to tak je. Nastavím si podľa počtu údajov prvý stĺpec. Ten bude ako parameter v CountIf. Vlookup potrebuje ale ucelenú viacstĺpcovú tabuľku, teda preto Resize. No a SumIf potrebuje dve samostatné oblasti preto Offset.
No, tak s tou rýchlosťou by sa dalo podstatne pohnúť, ak by nebolo vkladanie vzorcov k duplicitným hodnotám, ale výpočet do kolekcie a iba raz. Potom by sa z kolekcie ťahali len hotové výpočty.
Sub VlozVzorce3()
Dim DR As Long, VR As Long, D(), V(), VV(), i As Long, Col As New Collection, Item, RNG1 As Range, RNG2 As Range, RNG3 As Range
With List2
DR = .Cells(Rows.Count, 1).End(xlUp).Row - 1
D = .Cells(2, 1).Resize(DR, 2).Value
Set RNG1 = .Cells(2, 1).Resize(DR)
Set RNG2 = RNG1.Offset(0, 1)
Set RNG3 = RNG1.Resize(, 2)
End With
With List1
VR = .Cells(Rows.Count, 2).End(xlUp).Row - 4
V = .Cells(5, 2).Resize(VR).Value
End With
On Error Resume Next
With WorksheetFunction
For i = 1 To DR
Item = Col(CStr(D(i, 1)))
If Err.Number <> 0 Then
Col.Add Array(.SumIf(RNG1, D(i, 1), RNG2), .VLookup(D(i, 1), RNG3, 2, 0), .CountIf(RNG1, D(i, 1))), CStr(D(i, 1))
Err.Clear
End If
Next i
End With
ReDim VV(1 To VR, 1 To 5)
For i = 1 To VR
Item = Col(V(i, 1))
If Err.Number = 0 Then
VV(i, 1) = Item(0)
VV(i, 3) = Item(1)
VV(i, 5) = Item(2)
Else
Err.Clear
End If
Next i
List1.Cells(5, 3).Resize(VR, 5).Value = VV
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.