Příspěvky uživatele

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.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
With Worksheets("A")
.Cells(.Cells(Rows.Count, IIf(Bunka.Column = 1, "A", "H")).End(xlUp).Row + IIf(IsEmpty(.Cells(1, IIf(Bunka.Column = 1, "A", "H"))), 0, 1), 1) = Bunka.Value
End With
Next Bunka
End If
End Sub
Vyskúšaj, toto dávam v polospánku zbrucha na tablete.

No daj teda, keď bude čas pozriem to. Buď to hoď sem ako prílohu či link, alebo mi hoď link do "vzkazy", alebo ak je to súkromnejšieho charakteru, pošli mi to mailom (keď klikneš na nick, mám tam mail).

Ten môj vzorec funguje na Office 2013 Pro SK x64 a W8.1.1. To mám poslať obrázok ? Na prvej poskytnutej vzorke, na ktorú je šitý na mieru.
Na tej druhej vzorke samozrejme nefunguje, to je jasné, lebo je úplne inak konštruovaná. To som písal hneď, že záleží na tom aká je rôznorodosť typov "dátumov".
Čo sa týka nižších verzií Office, tak napr. na 2003 napr. tuším nieje NUMBERVALUE. Ale je zbytočné to riešiť takýmito podmienkami, z viacerých dôvodov. Takže sa orientovať jedine smerom matice.

Presne tak, pre všetky tieto na prvý pohľad neuvedomené drobnosti, je to taký zvláštny problém.

Dnes som niečo podobné robil, preto som sa k tomu vrátil.
Skúsil som upraviť aj fnc od eLCHa tak, aby eliminovala zdvojené oddeľovače a oddeľovač na konci, pri prázdnych bunkách:
Function CONCATENATE_RANGE(rRange As Range, Optional sDelimiter As String = ",") As String
Dim pos As Long, DoubleDelimiter As String
DoubleDelimiter = sDelimiter & sDelimiter
CONCATENATE_RANGE = Join(Evaluate("TRANSPOSE(" & rRange.Address & ")"), sDelimiter)
pos = 1
Do Until pos = 0
CONCATENATE_RANGE = Replace(CONCATENATE_RANGE, DoubleDelimiter, sDelimiter)
pos = InStr(pos, CONCATENATE_RANGE, DoubleDelimiter)
Loop
CONCATENATE_RANGE = Left(CONCATENATE_RANGE, Len(CONCATENATE_RANGE) - IIf(Right(CONCATENATE_RANGE, Len(sDelimiter)) = sDelimiter, Len(sDelimiter), 0))
End Function
Ako sa vyhnúť cyklu pri odstraňovaní zdvojených (a viac) oddeľovačov ale neviem.
To s pomocným listom je zaujímavé. Ani jedno ale nedokáže spojiť 2D oblasť.
Preto si myslím, že toto je lepšie a spojí 2D:
Function fSpoj(ByRef Rozsah As Range, Optional Oddel As String = ",") As String
Dim Bunka As Range
For Each Bunka In Rozsah
If Bunka <> "" Then fSpoj = fSpoj & IIf(Bunka.Address = Rozsah.Cells(1).Address, "", Oddel) & Bunka
Next Bunka
End Function

Vzorec na dodanej vzorke normálne funguje. Prikladám.

Funguje tak, že sa hľadá medzera. Ak sa nájde tak ostane len text pred touto medzerou. Z tohto redukovaného textu sa potom testuje či posledný znak je číslo, ak nie, tak sa posledný znak vynechá. A tento opäť redukovaný text by mal byť z pravej strany "očistený". Potom teda testujem, či sú v zostávajúcom texte posledné 4 znaky číslo. Ak áno je to rok, ak nie, nezobrazí nič. Ak máš ešte iné "nečistoty" v texte, treba zakomponovať, lebo to inak dá "", pretože sa stále testuje na chybu.
PS: Nepotrebuješ pomocný stĺpec F s rokmi. Ale vravím, záleží aké všelijaké typy "nečistôt" tam v tom texte sú.

Mischell, Mischell ... stále asi nevieš, čo som mal na mysli. Takže takto. Tu máš tú tabuľku úplne prerobenú. Snáď teraz už zbadáš o čom hovorím, že je problém s nerovnakým počtom a šírkou stĺpcov. To nejde vložiť nijako automaticky na 2 kliky, ako by si si predstavovala.

-Nakreslil som si čiary ohraničujúce stĺpce prvej tabuľky
-Tipol som si (keďže to nechceš povedať), ktoré stĺpce z tabuľky 2 sa môžu zlúčiť, ktoré vynechať, a znovu som si nakreslil ich okraje. Uhádnuť čo tam pôjde za údaje, akého typu a dĺžky sa mi fakt nechcelo, tak sú všetky stĺpce rovnaké. Pridal som tieto okraje k tým prvým na prvý list.
-Podľa týchto dvoch RÔZNYCH okrajov, som popridával stĺpce a ich šírky upravil tak, aby vždy každá načrtnutá čiara bola na nejakom okraji stĺpca.
-Všetky bunky som pozlučoval tak, aby vznikli cca pôvodné tabuľky s požadovaným počtom stĺpcov.

Už to chápeš, čo som mal stále na mysli ?

2 Alfan: Na tie prípady, ktoré tam máš uvedené by stačil takýto vzorček:
=IFERROR(NUMBERVALUE(RIGHT(LEFT(A2;IF(ISERROR(FIND(" ";A2));IF(ISNUMBER(NUMBERVALUE(RIGHT(A2;1)));LEN(A2);LEN(A2)-1);LEN(A2)-(LEN(A2)-FIND(" ";A2)+1)));4));"")
Neviem, koľko ešte iných "typov" pripadá do úvahy. Prípadne vyskúšať skomoliť nejakú maticu (to bude ale pre mňa asi nadľudské

)

Nástrel, žeby...
PS: Ja si totiž myslím, že Nikitka tým Dialógovým oknom myslí svoj Form, a nie implementovaný Dialóg Excelu.

Toto musí byť makrom, takže choď do okna VBA (Alt+F11), kde 2x klikneš na List1, a tam vlož tento kód:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
With Worksheets(IIf(Bunka.Column = 1, "A", "B"))
.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + IIf(IsEmpty(.Cells(1, 1)), 0, 1), 1) = Bunka.Value
End With
Next Bunka
End If
End Sub
Funkcia funguje aj keď príde k zmene viacerých buniek naraz v oboch stĺpcoch (napr kopírovaním).

Mám tu na disku takúto pomôcku. Mrkni, a prípadne si vyber maticový vzorec, ktorý by ti vyhovoval, ak by to mohlo byť pomocným stĺpcom. Mám tam aj s radením vzostupným a zostupným, aj bez radenia len jedinečné...

-Pridal som tlačítka na odobranie alebo pridanie riadku, na mieste, kde stojí kurzor.
-Môžeš samozrejme pridávať a mazať riadky aj cez pravý klik, cez tlačítka mi to príde rýchlejšie.
-Riadok na ktorom stojí kurzor sa vyfarbuje
-Pretekanie záznamov funguje aj pri zmene v iných listoch ako len v prvom.
-Maximálny počet listov je nastavený na 12. Ak príde k pretečeniu 12-teho listu, údaje zmiznú.
-Listy sa pridávajú a mažú automaticky.
-Makro som popísal, ale po popísaní som robil ešte dosť zmien, tak popis nemusí úplne presne sedieť, ale už sa mi to nechce kontrolovať.
-Na mojom PC je to rýchlostne OK, aj pri 12 listoch. Neviem aký máš PC vyskúšaj.
-Je to robené pomocou polí, pretože toľkonásobný prestup z VBA do Excelu by bol inak pomalší. Ešte by sa to možno dalo upraviť, čo sa rýchlosti týka, ale to už naozaj nemienim štelovať, pretože ako vidíš je to dosť zložitý kód.
-Ak tam budeš vkladať dáta cez kopírovanie, tak v žiadnom prípade nepoužívaj len Ctrl+V (alebo Vložiť). Zlikviduje to podmienené formátovanie, pretože Excel nevkladá len hodnoty pri obyčajnom Vložení. Vkladaj to cez tlačítko Prilepiť - Hodnoty (ikonka "1,2,3") na karte "Domov".

Snáď to bude dobré.

Mám pre Teba niečo hotové. Ale narazil som opäť na nedostatočný popis, a nelogickosti z toho vyplývajúce. Takže ešte doplňujúce otázky:

1. Ako budeš vkladať riadok do Listu1 ? Pklik na okraj a Vložiť ? Ak áno, tak treba ešte zmazať zostávajúce orámovanie tabuľky na 26 riadku (to tam automaticky zostane). Nieje problém, len to potrebujem vedieť.

2. Zmazanie riadku bude prebiehať ako ? Obdobne ako vloženie nového (viď vyššie), alebo iba označíš a dáš DELETE?

3. Tie čísla 1.-25. v prvom stĺpci tam vždy zostávajú nezmenené, neposunuté ? Ak áno, to treba doriešiť, napr. pri vložení riadku sa posunú. Záleží čo znamenajú tie čísla v reále, ak číslo riadku, musia ostať (upraviť sa), ak napr. číslo faktúry musia sa posúvať (teda nesmú ostať na mieste)

4. Ak nastane, že je v Liste1 viac ako 25 riadkov, kam sa má premiestniť posledný 26. riadok ? Do listu2 na prvé miesto, alebo do listu3 na posledné miesto?

5. Ak nastane, že je v liste1 menej ako 25 riadkov, teda 24, má sa na posledné miesto v liste1 premiestniť prvý riadok z listu2 alebo posledný riadok z listu3 ?

6. Čo sa stane, ak budeš mať viac záznamov ako 3*25=75 (na troch listoch) ? Majú sa nadbytočné ignorovať, teda sa zmažú posledné v liste 3, a ostatné sa posunie, alebo sa vytvorí 4. list a dajú sa tam ?

Algoritmus ako taký mám už hotový a funkčný, ale treba ho upraviť podľa týchto otázok. Prosím odpovedz jednoznačne a stručne na každú z nich.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje