Příspěvky uživatele
< návrat zpět
Ale no tak. Veď Vy tam máte dávať predsa vždy ten CZ ekvivalent, a nie SK 
Udávam vždy obe varianty.
Nezadal ste vzorec ako maticový. Teda nie Enter, ale Ctrl+Shift+Enter.
V prípade objektu Tabuľka je potreba ešte zmeniť rozsahy
=IFERROR(INDEX(DataDopln[text];MATCH("*";IFERROR(""&MATCH(DataDopln[cislo];[@[Číslo účtu ]];0);FALSE);0));"")
=IFERROR(INDEX(DataDopln[text];POZVYHLEDAT("*";IFERROR(""&POZVYHLEDAT(DataDopln[cislo];[@[Číslo účtu ]];0);NEPRAVDA);0));"")
prípadne môžeme zmeniť vzorec aj na
=IFERROR(INDEX(DataDopln[text];MATCH(1;COUNTIF([@[Číslo účtu ]];DataDopln[cislo]);0));"")
=IFERROR(INDEX(DataDopln[text];POZVYHLEDAT(1;COUNTIF([@[Číslo účtu ]];DataDopln[cislo]);0));"")
Inak tú funkciu FILTER má Office 2021 a 365. Tiež mám v pláne už update ...
@lubo: fnc FILTER nemám, teda neoverím, ale SEARCH/HLEDAT nájde 511* aj v 051100, čo je nesprávne.
Dalo by sa to ošetriť pridaním nejakého znaku do reťazcov:
...SEARCH(" "&DataDopln[cislo];" "&[@[Číslo účtu ]])...
...HLEDAT(" "&DataDopln[cislo];" "&[@[Číslo účtu ]])...
Pokúsil som sa pochopiť tie Vaše výpočty, názvy premenných a čo by mohli znamenať (aj vzhľadom na popis v Application.InputBox) ale nedarí sa mi to rozlúštiť.
Napr. čo je ZbytekNaKotouci s popisom "zadej zbytkové množství v balíku 0, 60, 70" ???
To máte napr. nejaký štítkovač, a sem zadávate neminuté štítky v "balíku", aby sa najskôr minuli tie? Až potom sa budú míňať ďalšie balíky štítkov? Ako sa potom číslujú tie listy ak bude ZbytekNaKotouci=100?
1. list "1" - "1/5" - "100"
2. list "2" - "2/5" - "1000"
3. list "3" - "3/5" - "1000"
4. list "4" - "4/5" - "1000"
5. list "5" - "5/5" - "500"
???
Lenže nedáva zmysel, aby ten posledný list bol prvým listom v PDF.
Načo potom slúži premenná "pocetstran" ?
Majú tieto nastavenie premenných cez Application.InputBox nejaký súvis s tým listom "dodací list"?
Začal som to prerábať z mnohých InputBoxov na jeden UserForm, kde sa zadajú dáta naraz - oveľa viac User-Friendly. Len mi to dovysvetlite.
Ak ste priložil nejaký súbor, tak neprešiel. Buď je to xlsm a treba ho za-ZIP-ovať, alebo je veľký a treba ho zmenšiť tak cca do 300 kB.
O akú verziu Office sa jedná?
Ktorú verziu riešenia máte na mysli? Ak tú od "lubo", potrebujete Office 2021 alebo 365.
Odkaz na iný list (apostrofy nie sú potrebné ak názov neobsahuje medzeru)
'názov listu'!A1:B1
V prípade prevedenia oblasti na Tabuľku (nazývané ako Tabuľka s veľkým "T", alebo ListObject alebo Excel Table) cez Ctrl+T, sa na žiadny list neodkazujete. Ale iba na názov Tabuľky prípadne na jej stĺpce
tblUdaje
tblUdaje[[cislo1]:[cislo2]]
...
Iná možnosť by bol maticový vzorec, kde netreba testovať najskôr "04", no zápis by musel byť korektný (počet znakov "?" Vám nesedí, máte v 3 číselnej maske 4 otázniky, čo je 7 znakov). Tak radšej takto:
04*
511*
518*
=IFERROR(INDEX(dopln!$B$2:$B$4;MATCH("*";IFERROR(""&MATCH(dopln!$A$2:$A$4;List2!A2;0);FALSE);0));"")
=IFERROR(INDEX(dopln!$B$2:$B$4;POZVYHLEDAT("*";IFERROR(""&POZVYHLEDAT(dopln!$A$2:$A$4;List2!A2;0);NEPRAVDA);0));"")
Dajú sa použiť rôzne kombinácie COUNTIF, INDEX, SMALL, MATCH, VLOOKUP...
@lubo: už som na tú 2021 zlomený, len musím ešte počkať 
??? Celý ten kód je divný. Od prepočtu tých listov na kotúče, zvyšku a pod., až po 2x po sebe určovanie menného zoznamu listov a pod. Včetne toho, že Váš príklad urobí listy
1. list "1" - "2/4" - "1000"
2. list "2" - "3/4" - "1000"
3. list "3" - "4/4" - "600"
4. list "4" - "1/4" - "1000"
PDF to vytvorí s 8 stránkami (každý list na 2 str). Ak pochopím, čo to tam ako rátate (pre mňa neskutočne nepochopiteľný zápis v kóde), tak bude stačiť pri vytváraní iba zmeniť poradie listov.
EDIT:
To nebude celý kód, všakže? Vzhľadom na nepoužité globálne premenné ako napr. "varinput".
Toto myslíte ako fakt vážne?
...Filename:=xlQualityStandard...
to je kvalita PDF a nie názov súboru
List1 - musíte nakopírovať vzorce na dostatočne veľkú oblasť
List2 - obabrete to automatickým rozširovaním cez objekt Tabuľka
Ak teda už fakt neviete čo s tou likviditou, a prehadzujete tie prebytky hospodárenia doma vidlami, tak pošlite za kalíšok pre fórum
Pekný deň.
Pridať kontrolu čísla je prkotina. Najdlhšie na celom kóde je skladanie Msg oznamu :)
Sub Nova_KJ()
Dim kj As String, NoZnak As String, No2Znak As String, Z As String * 1, MSG As String
Dim i As Long, bNumOK As Boolean
Dim LO As ListObject
Const VALID As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 'validní znaky celkově
Const VALID2ZNAK As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'validní znaky 2. znaku
Set LO = wsKJ.ListObjects("DataKj") 'název Tabulky na listě kj
Do
On Error Resume Next 'pokud uživatel stiskne klávesu ESC nebo Cancel nebo křížek nebo zadá "", kód skočí do řádku s "Exit Sub"
kj = UCase(InputBox("Zadejte novou RZ:" & vbNewLine & "(7 znaků, bez mezer a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel", Default:=kj))
If Err.Number <> 0 Or kj = "" Then Exit Sub 'pokud uživatel stiskne klávesu ESC nebo Cancel nebo křížek nebo zadá "", ukončí se makro
On Error GoTo 0 'vynulování chybového čísla
If Len(kj) < 7 Or Len(kj) > 8 Then
MsgBox "Opravte RZ - (nesprávný počet znaků {" & Len(kj) & "}, vyžadováno 7-8 znaků)", vbExclamation
Else
NoZnak = "" 'nepovolené znaky
No2Znak = "" 'nesplněna podmínka 2. znak = písmeno
bNumOK = False 'příznak, zda text obsahuje číslo
For i = 1 To Len(kj) 'prověření znaků
Z = Mid$(kj, i, 1)
bNumOK = bNumOK Or IsNumeric(Z) 'někde je číslo
If i = 2 Then 'ověření, zda je 2. znak písmeno
If InStr(1, VALID2ZNAK, Z) = 0 Then No2Znak = vbNewLine & "Znak č. 2 {" & IIf(Z = " ", "mezera", Z) & "} musí být písmeno A-Z"
End If
If InStr(1, VALID, Z) = 0 Then NoZnak = NoZnak & vbNewLine & vbTab & IIf(Z = " ", "mezera", Z)
Next i
MSG = NoZnak & No2Znak 'složení správy o chybě
MSG = IIf(MSG = "", "", vbNewLine & vbNewLine & "Nepovolené znaky :" & MSG)
If Not bNumOK Then MSG = MSG & vbNewLine & vbNewLine & "Chybí aspoň 1 číslo"
If MSG <> "" Then
MsgBox "Opravte RZ - (bez mezer a speciálních znaků)" & MSG, vbExclamation
Else
Exit Do 'opakování končí validním zadáním
End If
End If
Loop
wsKJ.Cells(LO.Range.Columns(1).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1, "A").Value2 = kj 'přidání kj na konec Tabulky DataKj
LO.Range.RemoveDuplicates Columns:=1, Header:=xlYes 'smazání duplicitních kj
LO.Range.Columns(1).Sort key1:=LO.Range.Columns(1), order1:=xlAscending, Header:=xlYes 'seřazení kj
MsgBox "HOTOVO - nová RZ uložena", vbInformation
End Sub
Ak som to pochopil tak napr.
Sub Nova_KJ()
Dim kj As String, NoZnak As String, No2Znak As String, Z As String * 1
Dim i As Long
Dim LO As ListObject
Const VALID As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 'validní znaky celkově
Const VALID2ZNAK As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'validní znaky 2. znaku
Set LO = wsKJ.ListObjects("DataKj") 'název Tabulky na listě kj
Do
On Error Resume Next 'pokud uživatel stiskne klávesu ESC nebo Cancel nebo křížek nebo zadá "", kód skočí do řádku s "Exit Sub"
kj = UCase(InputBox("Zadejte novou RZ:" & vbNewLine & "(7 znaků, bez mezer a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel", Default:=kj))
If Err.Number <> 0 Or kj = "" Then Exit Sub 'pokud uživatel stiskne klávesu ESC nebo Cancel nebo křížek nebo zadá "", ukončí se makro
On Error GoTo 0 'vynulování chybového čísla
If Len(kj) < 7 Or Len(kj) > 8 Then
MsgBox "Opravte RZ - (nesprávný počet znaků {" & Len(kj) & "}, vyžadováno 7-8 znaků)", vbExclamation
Else
NoZnak = "" 'nepovolené znaky
No2Znak = "" 'nesplněna podmínka 2. znak = písmeno
For i = 1 To Len(kj) 'prověření znaků
Z = Mid$(kj, i, 1)
If i = 2 Then 'ověření, zda je 2. znak písmeno
If InStr(1, VALID2ZNAK, Z) = 0 Then No2Znak = vbNewLine & "Znak č. 2 {" & IIf(Z = " ", "mezera", Z) & "} musí být písmeno A-Z"
End If
If InStr(1, VALID, Z) = 0 Then NoZnak = NoZnak & vbNewLine & IIf(Z = " ", "mezera", Z)
Next i
If NoZnak & No2Znak <> "" Then
MsgBox "Opravte RZ - (bez mezer a speciálních znaků)" & vbNewLine & "Nepovolené znaky :" & NoZnak & No2Znak, vbExclamation
Else
Exit Do 'opakování končí validním zadáním
End If
End If
Loop
wsKJ.Cells(LO.Range.Columns(1).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1, "A").Value2 = kj 'přidání kj na konec Tabulky DataKj
LO.Range.RemoveDuplicates Columns:=1, Header:=xlYes 'smazání duplicitních kj
LO.Range.Columns(1).Sort key1:=LO.Range.Columns(1), order1:=xlAscending, Header:=xlYes 'seřazení kj
MsgBox "HOTOVO - nová RZ uložena", vbInformation
End Sub
Ale máte tam aj iné dĺžky kj (3, 9, 6, aj s nepovolenými znakmi {medzera, pomlčka} ...)
Ja som objekt toho Vášho listu "kj" vo VBA premenoval z List5 na wsKJ. To je tzv CodeName listu (nezávislé od popisu na ušku listu). V prílohe to je vidieť. Je to namiesto
Set ws = ThisWorkbook.Sheets("kj")
alebo namiesto nič nehovoriaceho List5.
Do deklarácií pridajte
Dim S() As String, i As Integer
A potom toto
Stlp = wsOdstranovanie.Range("B1").Value
Stlp = Stlp & ":" & Stlp
nahraďte týmto
S = Split(wsOdstranovanie.Range("B1").Value, ",")
For i = 0 To UBound(S)
S(i) = S(i) & IIf(InStr(1, S(i), ":") > 0, "", ":" & S(i))
Next i
Stlp = Join(S, ",")
a ešte pred
Set appExcel = New Excel.Application
pridajte
Stlp = Replace(rng.Address(0, 0), ",", ";")
Zaujímavé je, že v obslužnom Exceli sa oblasti stĺpcov v Range odkazujú pomocou čiarky A:A,C:C,FM:FN no v skrytej druhej inštancii Excelu sa odkazujú pomocou bodkočiarky A:A;C:C;FM:FN. Inak to vedie k chybe. Každopádne Vy po úprave zadávate nasledovný formát do bunky B1
Napr.:
A
A,C
A,C,FN
A,C,FM:FN
A:A,C:C,FM:FN
A:B,G,FM:FO
...
a obdobné kombá
Presne tak. Kým som sa dostal k dokončeniu, už ste to postol. Vložím to sem teda ešte kvôli iným veciam, ako použitie Tabuľky keď už ju tam máte, odstránenie duplicít bez cyklu.
Sub Nova_KJ()
Dim kj As String, NoZnak As String
Dim i As Long
Dim LO As ListObject
Const VALID As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 'validní znaky
Set LO = wsKJ.ListObjects("DataKj") 'název Tabulky na listě kj
Do
On Error Resume Next 'pokud uživatel stiskne klávesu ESC nebo Cancel nebo křížek nebo zadá "", kód skočí do řádku s "Exit Sub"
kj = UCase(InputBox("Zadejte novou RZ:" & vbNewLine & "(7 znaků, bez mezer a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel", Default:=kj))
If Err.Number <> 0 Or kj = "" Then Exit Sub 'pokud uživatel stiskne klávesu ESC nebo Cancel nebo křížek nebo zadá "", ukončí se makro
On Error GoTo 0 'vynulování chybového čísla
If Len(kj) <> 7 Then
MsgBox "Opravte RZ - (nesprávný počet znaků {" & Len(kj) & "}, vyžadováno 7 znaků)", vbExclamation
Else
NoZnak = "" 'nepovolené znaky
For i = 1 To 7 'prověření znaků
If InStr(1, VALID, Mid$(kj, i, 1)) = 0 Then NoZnak = NoZnak & vbNewLine & IIf(Mid$(kj, i, 1) = " ", "mezera", Mid$(kj, i, 1))
Next i
If NoZnak <> "" Then
MsgBox "Opravte RZ - (bez mezer a speciálních znaků)" & vbNewLine & "Nepovolené znaky :" & NoZnak, vbExclamation
Else
Exit Do 'opakování končí validním zadáním
End If
End If
Loop
wsKJ.Cells(LO.Range.Columns(1).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1, "A").Value2 = kj 'přidání kj na konec Tabulky DataKj
LO.Range.RemoveDuplicates Columns:=1, Header:=xlYes 'smazání duplicitních kj
LO.Range.Columns(1).Sort key1:=LO.Range.Columns(1), order1:=xlAscending, Header:=xlYes 'seřazení kj
MsgBox "HOTOVO - nová RZ uložena", vbInformation
End Sub
Tie ostatné makrá sú divné tiež. Tie som zatiaľ neriešil.
Vo virtuálke mám starý MacOS Siera + Office 2016.
Konkrétne táto chyba vzniká pri pokuse vytvoriť objekt
CreateObject("Scripting.FileSystemObject")
ktorý je použitý na vytvorenie chýbajúcej adresárovej štruktúry. MacOS nič také nepozná. Tam by sa to muselo riešiť jedine cez MkDir v cykle alebo rekurzii.
Oddeľovač ciest je "/" namiesto "\".
Ďalším problémom je nutnosť používať na overenie existencie cesty Dir() obalenie do On Error Resume Next. To je prkotina, ale gro problému pri nej spočíva inde. MacOS nedovolí prístup do adresárov len tak. Musíte povoliť prístup. To nejde urobiť programovo. Sú iba nejaké adresáre, ktoré toto nevyžadujú, ale cesta k nim je krkolomná, názvy nezmyselné, a navyše vo Finder (Prieskumník) sa k nim nedostanete. Treba použiť zase ďalší skript, ktorý Vám vytvorí na tento adresár odkazy do Obľúbených a neviem kam ešte.
Popisuje to aj RdB:
Make and Mail PDF files with VBA code on your Mac
Problems with Apple’s sandbox requirements
Uznajte, že používať namiesto plochy toto
/Users/rondebruin/Library/Group Containers/UBF8T346G9.Office
je na palicu. Cez prieskumníka sa tam navyše normálne nedostanete.
Editácia makra v MacOffice je učinená hrôza. Chýba náhľad na hodnotu premennej, okno Watches, Immediate, nefunguje Ctrl+C/V, nefunguje krok späť Ctrl+Z ...
Teda na celkové prerobenie makra na multifunkčnosť, vzhľadom na komplikácie, by som musel mať setsakramentsky dobrú náladu. A to teda nemám. Pôvodný kód bol môj, problém identifikovaný, riešiť sa mi to ale momentálne nechce.
Návrh cez polia a kolekcie.
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články