Zo srandy som skúsil vypotiť brutálny megavzorec namiesto makra. Teraz nastavené na 1000 hodnôt. Výpočtová doba sa ako tak dá zniesť...
Ja som to robil cez pole. Bol ste rýchlejší.
Prosím ? A kde sú tie ostatné listy, ktorých sa makro týka ? Prečo ste posunuli takú drobnosť ako pozíciu smerodatného dátumu z M1 do L1 ? To musím vždy skúmať všetky rozdiely s predošlou verziou ? To ma fakt nebaví. Názov súboru vo mne navyše evokuje pocit, že sa polka makier používať nebude, a zoznam pacientov bude samostatný súbor vedľa súborov spotreby materiálu. Podmienený formát je práveže lepší a jednoduchší ako riešenie ofialovenia riadkov na základe "1" makrom. Jednoduchšie je nechať aj orámovanie tabuľky na PF (akurát nebude vonkajšie hrubšie). Upravené makro som uložil do tohto súboru, a uvidíme, či si to budete vedieť presunúť do toho pôvodného, ak sa vôbec bude pôvodná skladba makrá+listy používať. A ak nie, tak bude treba makro zasa prekopať.
Ponechanie prvých riadkov oddelení - znamená ponechanie dát vo všetkých stĺpcoch v tom prvom riadku, alebo len ponechanie čísla 1 a názvu oddelenia ?
Kvôli zmene orámovania (PF), som upravil aj "CommandButton1_Click", navyše tam bolo adresovanie od riadku 3 (asi nejaká pôvodná verzia). "CommandButton2_Click" ani neskúmam, čo robí, také tlačítko tam nemáte (pravdepodobne pozostatok po odstránení tlačítka).
Použite fnc IF/KDYŽ alebo IFERROR.
=IF(AND(E2<=7;F2<=15;G2<=3;H2<=5;I2<=3);"OK";"NOK")
=KDYŽ(A(E2<=7;F2<=15;G2<=3;H2<=5;I2<=3);"OK";"NOK")
alebo len zo srandy matica
{=IF(SUM((E2:I2<={7\15\3\5\3})*1)=5;"OK";"NOK")}
{=KDYŽ(SUMA((E2:I2<={7\15\3\5\3})*1)=5;"OK";"NOK")}
Napr.
No to je problém. My nevieme ako to je koncipované, a ako to bude používané, či je to tabuľka alebo Object Tabuľka, či sú pod dátami kód a názov ešte iné dáta v tých stĺpcoch, kde sú vzorce, kde iba hodnoty, či sú počiatočné riadky a stĺpce fixné alebo nie, či tam môže byť výberový zoznam alebo nie, ako je vyriešené dopĺňanie nových riadkov, a či je počet riadkov obmedzený (ďalšími objektami alebo nastavením tlače ...), či a aké sú tam vlastne stĺpce (Celkom, s PDH, bez ...), lebo aj Celkom som si tam domyslel, to ste tam nemal.
atď...
To sa bez reálnej prílohy (po odmazaní citlivých info, ale ponechaní štruktúry) nedá.
ponechanie pôvodných hodnôt: Je tu možnosť zapnúť iteračný výpočet, kde by sa testoval nejaký príznak (napr. v nejakej bunke by bolo "Vybavené") a na základe toho by vzorec buď odkazoval sám na seba, alebo počítal s aktuálnymi dátami. No nie som si istý ako sa to zachová, ak sa súbor náhodou otvorí na PC, kde iteračný výpočet zapnutý nieje (a to predvolene nieje). Myslím, že automaticky nenávratne zničí staré dáta. Teda jednoduché riešenie je, po vybavení označiť tabuľku, Ctrl+C, pklik a výber Hodnoty.
Ak náhodou nepotrebujete zároveň robiť zoznam mien v tabuľke, ale máte ho pevný, tak aj maticovým vzorcom. Príklad:
Pozrite sa sem na to ako je riešený variant "variant v zošite, zmenou bunky B1"
Je to pripravené aj na nejaké tie "psie kusy", ako napr. nesprávna hodnota, mazanie, nesúvislá oblasť... vyskúšajte. Nieje to merná minca, ale len návrh.
Ale POZOR, platí pri tom to, čo pri makrách väčšinou : Je to naprogramované presne na túto situáciu ! Teda nemôžete len tak bez úpravy makra meniť poradie stĺpcov, riadkov, atď. Ako sa tu často deje, že človek pripraví na mieru makro, ktoré si užívateľ potom prenesie do úplne inak koncipovaného súboru, a potom nefachá.
Ak budú dáta začínať tak ako ich máte od 14. riadku, a ak budú v rovnakých stĺpcoch ako to máte, a ak v nich budú o 14. riadku po koniec len čísla k násobeniu alebo prázdne, tak napr. :
Sub EUR_CZ()
Dim Kurz As Single, t As String, R As Long, D(), i As Long
t = InputBox("Zadajte kurz EUR->CZ :", "Kurz", 0#)
If t = vbNullString Then MsgBox ("Nebol zadaný kurz."): Exit Sub
If IsNumeric(t) Then Kurz = Val(t) Else MsgBox ("Nesprávna hodnota kurzu."): Exit Sub
With ActiveSheet
R = .Cells(Rows.Count, 1).End(xlUp).Row - 13
If R < 1 Then MsgBox ("Chýbajú data od riadku 14."): Exit Sub
D = .Cells(14, 8).Resize(R, 8).Value
On Error Resume Next
For i = 1 To R
If D(i, 1) <> "" Then D(i, 1) = D(i, 1) * Kurz
If D(i, 4) <> "" Then D(i, 4) = D(i, 4) * Kurz
If D(i, 7) <> "" Then D(i, 7) = D(i, 7) * Kurz
Next i
.Cells(14, 8).Resize(R, 8).Value = D
If Err <> 0 Then MsgBox ("Ukončené s chybou.")
End With
End Sub
Nevadia mu ani tie Vaše divotvorné zlúčenia. Ale predpokladám, že budete mať každý mesiac nový súbor. To bude nepraktické prenášať makro, alebo prekopírovávať dáta do súboru s makrom. Dá sa urobiť doplnok do Excelu, ktorý pridá nástrojovú lištu s tlačítkom. To bude dostupné v každom exceláckom súbore, ale aj v tých, ktorých sa to netýka...
Ak by tých riadkov a listov bolo veľa, tak by som to urobil cez pole a skrýval ich naraz. Napr. takto nejako. Je to Dynamicky nastaviteľné pomocou konštánt a poľa podmienok.
Sub Skryt_Riadky_Podmienene()
Dim Podmienka(), Riadok As Long, TMP As Integer, RNG As Range, aData(), WS As Worksheet
Const PRVY = 50
Const POSLEDNY = 400
Const STLP = 1
Podmienka = Array("254.420", "254.423", "254.424")
Application.ScreenUpdating = False
On Error Resume Next
For Each WS In Worksheets
With WS
aData = .Cells(PRVY, STLP).Resize(POSLEDNY - PRVY + 1).Value
For Riadok = 1 To POSLEDNY - PRVY + 1
TMP = WorksheetFunction.Match(CStr(aData(Riadok, 1)), Podmienka, 0)
If Err = 0 Then
If RNG Is Nothing Then Set RNG = .Cells(Riadok + PRVY - 1, STLP) Else Set RNG = Union(RNG, .Cells(Riadok + PRVY - 1, STLP))
Else
Err.Clear
End If
Next Riadok
If Not RNG Is Nothing Then RNG.EntireRow.Hidden = True: Set RNG = Nothing
End With
Next WS
Set WS = Nothing
Application.ScreenUpdating = True
End Sub
Neviem či to chápem správne...
Len doplním, že ak chcete do bodky zachovať funkcionalitu Vášho vzorca, tak ten VLOOKUP / SVYHLEDAT obalte do IFERROR(VLOOKuP(...vaše hľadanie ...);E4)
NejK tak. Píšem z mobilu na posteli...
Pekne. Nejde mi síce zatiaľ do hlavy ten abs. $B$2 ale pekne. Nevedel som si ešte inak ako pom. stĺpcami predstaviť vytvorenie zoznamu jedinečných hodnôt z A a C spolu. Na to niečo jednoduchšie nieje ?
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.