Příspěvky uživatele

Tvoj riadok upravený na volanie funkcie, ktorá ruší diakritiku a zároveň predpripraví texty na veľké písmená
If BezDiakritiky(Sheets("prvni").Cells(1, 1).Value) Like BezDiakritiky("*" + Sheets("druhy").Cells(1, 1) + "*") Then

samotná funkcia - počíta s CZ a SK znakmi (ak som na nejaký zabudol, doplň si, ale veľké písmeno !)
Function BezDiakritiky(text As String) As String
Dim i As Integer
Const Diak = "ÁÄČĎÉĚÍĹĽŇÓÔŔŘŠŤÚŮÝŽ"
Const bDiak = "AACDEEILLNOORRSTUUYZ"
If IsNull(text) Then text = ""
If text = "" Then Exit Function
BezDiakritiky = UCase(text)
For i = 1 To Len(Diak)
BezDiakritiky = Replace(BezDiakritiky, Mid(Diak, i, 1), Mid(bDiak, i, 1))
Next i
End Function
Ešte raz opakujem, táto fnc je šitá na mieru presne pre Tvoj prípad, keď potrebuješ aj zmenu na veľké písmená (kvôli Like) aj zrušenie diakritiky. Ak by si chcel univerzálnu funkciu, musíš vynechať UCase a doplniť konštanty o malé písmená = 2x tak dlhý výpočet.

Dim prvnicislo As Long, sloupecjc As Long
prvnicislo = Range("H5").Value
sloupecjc = Range("H3").Value
Cells(4, 4).FormulaR1C1 = "=IF(R" & prvnicislo + 5 & "C" & sloupecjc - 5 & "="""","""",666)"
Za to 666 si dosaď tú ďalšiu subpodmienku alebo čo ti to tam začína.

If UCase(Sheets("prvni").Cells(1, 1).Value) Like UCase("*" + Sheets("druhy").Cells(1, 1) + "*") Then

A načo zakladáš nové vlákno ? To si mal napísať do toho predošlého.

No to si tak jednoducho iba predstavuješ.
- Ten INT() vo vzorci je na čo ? Má korigovať nepresnosť pri zaokrúhľovaní výpočtov ? Tak na to práve nefunguje. Na 14-tom desatinnom mieste vzniká niekedy 1, čo CEILING samozrejme promptne vyhodnotí ako ďalšiu štvrťhodinku. To som vyriešil nahradením INT() za 0,00000000000001.
- Vytvoril som pre zjednodušené vytvorenie výpočtu sústavu Názvov so vzorcami. Zdajú sa trošku komplikovanejšie. Prečo - viď ďalší bod.
- Ty musím počítať s množstvom eventualít (PP=pracovná doba):
---začiatok je pred PP, koniec je pred PP
---začiatok je pred PP, koniec je počas PP
---začiatok je pred PP, koniec je po PP
---začiatok je počas PP, koniec je počas PP
---začiatok je počas PP, koniec je po PP
---začiatok je po PP, koniec je po PP
-Moje vzorce fungujú logicky v poriadku, tak ako znie zadanie - doslova. A to je ten problém. Rozpísal som tam ten prípad, keď 6-ta 15 minútovka začína počas PP, ale končí po PP. Za započatú 15 minútovku je potom logicky započítaná za obe sadzby. Riešenie som zatiaľ nevymyslel, a po vlastne zbytočnej snahe sa mi ho ani popravde nechce hľadať - zatiaľ.

Noo, pekné riešenie. Len treba predeklarovať funkcie pomocou "PtrSafe" na 64-bitových Office. Celé makro treba vyselektovať z množstva pre tento účel nepotrebných modulov a frms a zmeniť odkazy na sheets podľa potreby. Pekné. Škoda, že sa to nedá exnúť kliknutím mimo frm, ale len na X. Ale aj to by sa dalo asi Hook-nuť.

MID vyberie z textu nejakú časť.
MID("fero",2,3) urobí to, že z textu "fero" vyberie text, ktorý začína na znaku 2 a dĺžka vybraného textu bude 3.
Čiže výsledok = "ero"
V Tvojom prípade ale potrebuješ ešte pred a za touto vybranou časťou textu "*". Tak ich pred fnc aj za fnc MID prirátaš.
Na "prirátanie" (zlučovanie) textu by sa mal ale používať "&" a nie "+".

EDIT: Po opätovnom prečtaní dotazu si ale myslím, že dotaz bol myslený tak, že v liste "druhy" máš to čo chceš hľadať v "prvni". V tomto prípade nepotrebuješ fnc MID, ale iba pridáš "*"
If Sheets("prvni").Cells(1, 1).Value Like ("*" & Sheets("druhy").Cells(1, 1) & "*") Then

OK. Tak potom
ThisWorkbook.Save
funguje tak ako chceš.
Ešte tam vidím drobnosť. Ak chceš ukladať záznamy už od riadku 1, musíš výpočet posledného riadku upraviť napr takto
Radek = Cells(65000, 1).End(xlUp).Row + IIf(IsEmpty(Cells(1, 1)), 0, 1)
Už som to tu písal niekde, že ak je 1. riadok prázdny xlUp vráti 1, rovnako ako keď je 1. riadok plný. Ak budeš ukladať až od druhého riadku (v prvom je napr. titulok stĺpca), tak to môže byť ako si to mal. Toto riešenie čo uvádzam, funguje v oboch prípadoch.

Moje nervy, jednoznačnejší popis problému, a bolo by to ľahšie.

No vyskúšaj teda toto. Testuje to existenciu listov "Výrobna 1", "Výrobna 2", "Výrobna 3", "Výrobna 4". Overí, či je v B13 hodnota. Potom skopíruje data do jediného listu "Souhrn" v zošite "Souhrn.xls", a to v takom poradí, že najskôr všetky validné listy v spomínanom poradí z jedného súboru, až potom to isté z ďalšieho súboru. Všetko pod seba do jednej tabuľky.

To máš na mysli iba takúto blbinku ? Načo by to mohlo byť dobré netuším. Ak vykonávaš ešte nejakú akciu v ktorej môže nastať chyba, a bojíš sa o pád Excelu, tak to ošetri v bloku On Error. Nechceš to ty náhodou uložiť v jednom z tých 2 ukladaní ako SaveAs (Uložiť ako) - teda kópiu ?
Private Sub CommandButton1_Click()
Dim Radek As Long
ThisWorkbook.Save
Radek = Cells(65000, 1).End(xlUp).Row + 1
Cells(Radek, 1) = 1
Cells(Radek, 2) = "TÁŇA"
ThisWorkbook.Save
End Sub

Tá Tvoja odpoveđ je nejaká sklamaná či čo. To podm, formát. Čo som ti tam dal, nefunguje? Alebo si sklamany z toho, že ti nikto presbejšie nepomohol s tym spustenim?
Otvor si jedno okno kde máš ten súbor excelu, na druhej strane obrazovky si otvor ten adresar,čo je nan link v návode. Samoarejme si v ceste zmen meno konta na PC, pretiahni myšou ten xls počas držanie ľavýAlt, pustite v tom adresary najskor myš potom Alt. Vznikne Ti v zložke pre spustenie odkaz na tvoj subor. Hotovo, 5 sekúnd a 10 min písania...

Môže to byť napr. aj takto.
Zástupcu v položke Po spustení ti popísal Pavlus.

Opravená/upravená posledná verzia.
-Vstupné hodnoty majú obmedzenie iba na čísla (logické, keď sú potom násobené)
-Vážnejší problém je to Lock buniek. Tvoj návrh Lockne iba posledne upravenú bunku. Z celého Tvojho popisu je zrejmé, že musia byť v Locknutom režime všetky zapísané bunky. Preto je makro krapet komplikovanejšie ako pôvodné.
-Zmenil si riadok od ktorého sa na list A ukladajú zmenené bunky. To je zásadná zmena pre výpočet posledného zapísaného. Len napoviem, že ak začínaš od riadku 1, a ten je prázdny dostaneš posledný zaplnený 1, ak je tento prvý riadok zaplnený dostaneš rovnako 1. Preto musela byť predošlá verzia výpočtu posledného riadku na toto ošetrená. Nemôžeš len tak niečo meniť, bez toho aby to nemalo vplyv na funkčnosť.
-Makro je popísané

Myslíš takto ? Príloha je základ...
EDIT: Upravil som to, dávam aj novú vylepšenú prílohu.
-Len doplníš názov jedla, ak už tam je, vyberieš ho v zozname, ak tam nieje, tak ho dopíšeš a do zoznamu sa sám doplní.
-V zozname jedál sa ti automaticky zobrazujú jedinečné hodnoty zo zoznamu jedál
-Automaticky sa upravujú rozsahy Výberu aj Zoznamu - viď Definované názvy
-Automaticky sa spočíta počet výskytov jedla, aj počet kusov zapísaných v B.

Vyber si z toho čo potrebuješ. Prípadne si ešte skopíruj vzorce, alebo výberový zoznam (Overenie údajov) do ďalších riadkov.

Prepáč, zabudol som na tú poslednú "1". Teraz to už funguje. Iba som zmenil tie IIF na Prepinac, aby to bolo zreteľnejšie, a doplnil tento Prepinac aj namiesto tej poslednej "1".
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, Prepinac As String
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
Prepinac = IIf(Bunka.Column = 1, "A", "H")
With Worksheets("A")
.Cells(.Cells(Rows.Count, Prepinac).End(xlUp).Row + IIf(IsEmpty(.Cells(1, Prepinac)), 0, 1), Prepinac) = Bunka.Value
End With
Next Bunka
End If
End Sub

Urobil som niečo inakšie. Pracuje to so zatvorenými súbormi. Teda sa neotvárajú kvôli importu. Čas importu zo 400 súborov je cca 12 sekúnd. Zošity nemusia mať všetky listy. Makro je popísané.
Iste by to išlo urobiť aj inak (ADODB, SQL, ...). Škoda, že na zatvorený zošiť nefunguje EVALUATE.
Na *.xlsx som netestoval, iba na *.xls. V adresári so súbormi nesmú byť iné súbory ako excelácke.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje