Příspěvky uživatele

Príklad, aj s kontrolou či tam už nejaké dáta sú a pod. Spustíte to iba s ktorými stĺpcami chcete, vkladá rovno hodnoty, nie vzorce. AK by sa Vám nepozdávalo volať 50x procedúru pre každý stĺpec, môžeme to upraviť, aby urobilo všetko naraz.
Dim Otazka As Byte

Sub Vypocitaj()
Otazka = 0
Rozdel ActiveSheet.Columns(1)
Rozdel ActiveSheet.Columns(3)
End Sub

Sub Rozdel(STLP As Range)
Dim Riadkov As Long, Pole(), Kontrola As Long, i As Long, C

With STLP.Resize(Rows.Count - 1).Offset(1, 0)
Riadkov = STLP.Cells(Rows.Count, 1).End(xlUp).Row - 1
If Riadkov > 0 Then
Kontrola = WorksheetFunction.CountIf(.Offset(0, 1), "<>")
If Kontrola > 0 Then
Select Case Otazka
Case 0: Otazka = MsgBox("Vo výslednej oblasti sa už nachádzajú data." & vbNewLine & "Chcete ich prepísať ?", vbQuestion + vbYesNo, "Upozornenie")
If Otazka = 7 Then Exit Sub
Case 7: Exit Sub
End Select
End If

ReDim Pole(1 To Riadkov, 1 To 1)
If Riadkov = 1 Then Pole(1, 1) = .Value2 Else Pole = .Value2

On Error Resume Next
For i = 1 To Riadkov
If Pole(i, 1) <> "" Then
C = Split(Pole(i, 1), "-")
Pole(i, 1) = TimeValue(C(1)) - TimeValue(C(0))
Select Case Err.Number
Case Is > 0: Pole(i, 1) = CVErr(xlErrValue): Err.Clear
Case 0: If Pole(i, 1) < 0 Then Pole(i, 1) = CVErr(xlErrValue)
End Select
End If
Next i
On Error GoTo 0

.Offset(0, 1).Value2 = Pole
End If
End With
End Sub

Úprava + pár príkladov dátumových stavov.

Tak len príklad...

Ten Váš kód fungovať nemôže z niekoľkých dôvodov. Premenná RadekOut nikdy nenadobudne inú hodnotu ako 0. Následný cyklus For j% by mal hľadať klienta, no nerobí vôbec nič :) Ďalej o pár riadkov nižšie wsOutput nieje to isté ako wsOutpu.

Uvádzam 2 rozličné prípady. Jeden pridáva neexistujúceho klienta, druhý ho ignoruje.

Je to len ukážka. Záležať bude na tom, koľko dát spracovávate, lebo potom by sa vynechal zápis celého poľa dát, a prepisovali by sa napr. iba zmenené riadky (pozor zápis všetkých napr. 1000 riadkov po 13 stĺpcov nemusí byť pomalší ako zápis 20 riadkov po jednom), alebo by sa mohla použiť kolekcia a pod.

Ale na to slúži poriadne popísaná príloha s príkladom.

Pre možnosť vkladania príloh sa musíte zaregistrovať. Ak Vám nebude vyhovovať KT riešenie od mepexg, tak Vám to makro upravím, ale nechce sa mi vytvárať si zdrojové súbory...

Tak to vysvetľujte ako pre tých, ktorý nevedia čo chcete. To znamená do detailu presne.

1. Zoznam dát je dynamický?
2. Voľba účtu bude v jednej jedinej bunke ?
3. Voľba vety bude v jednej jedinej bunke ?
4. Účet bude vždy navolený len jeden z X?
5. Keď zvolíte účet, potom čo ? Chcete vedľa vidieť, ktoré vety patria pod tento účet, alebo chcete mať na výber z viet, ktoré patria pod tento účet ?
6. Ak si chcete vybrať z viet, ktoré patria pod vybraný účet, čo sa má potom udiať ?
7. Zdrojové dáta sú zoradené ?
8. Prečo nevyhovuje pomocný skrytý stĺpec ? (jeden by sa urobil na získanie jedinečných hodnôt účtov, a druhý na prináležiace vety, z oboch by bol načítavaný dynamický výberový zoznam, tabuľka by bola ako Tabuľka, teda vzorce by sa dopĺňali samé)
9. Ak chcete vidieť všetky vety na základe vybraného účtu, v tom prípade je určo najlepšie SmartFilter, obdobne ako poslal mepexg. Čo Vám nevyhovuje na tomto ?

Nemôžete iba hovoriť, toto je zlé, toto je kostrbaté, toto bude zložité, a čakať, že všetci budú stále tipovať a snažiť sa Vám dodávať rôznorodé riešenia, a Vy len stroho odmietnete. Veď povedzte čo presne Vám vadí na ktorom riešení. Neuviedol ste ani to, čo som sa pýtal už predtým, či sa bude jednať o jedinú bunku, alebo či ide o viacero buniek s rovnakou možnosťou výberu. A ako posledná vec, keď vám niečo nevyhovuje, tak okrem popisu toho čo nevyhovuje a prečo, pridajte presný manuálne vytvorený príklad toho ako to má vyzerať, kde napíšete kľudne do komentára v bunke, že toto tu chcem voliť v rozbaľovacom zozname z týchto dát (kľudne nakreslite šípky), a tuto chcem aby sa v tomto konkrétnom prípade zobrazilo presne toto, lebo to zodpovedá tejto a tejto voľbe...
Proste presne. Pochybujem, že som sám, ktorý nevie čo chcete...

No práve záleží na tom, čo ste neuviedol - čo s tým chcete robiť a čo dosiahnuť, ako sa to má používať. Ak poviete toto, bude sa dať premýšľať nad riešením.

Podľa mňa nechcete filtrovať tabuľku, ale chcete závislý výberový zoznam. Rozdiel je obrovský. To čo vy popisujete sa dá urobiť takto (príloha), a závislý výberový zoznam by musel fungovať na prerobenej tabuľke, kde by boli záznamy jednej úrovne pekne za sebou (stĺpec A) a potom by sa dala ľahko nájsť pozícia prvej bunky a počet rovnakých, ktoré by sa offsetovali na stĺp B, čo by bol zdroj pre závislý výberový zoznam. Takých riešení tu nájdete neúrekom. Výhodou by bola možnosť použiť ich viackrát (napr. fakturácia, vyskladňovanie a pod.). Lebo to čo opisujete je LEN na jednu bunku.

Ak rozumiem správne nieje potrebný maticový vzorec, ale stačí
=COUNTIF(C4:G15;C2)
Ak je 0 tak tam hodnota nieje, ak je >0 tak tam hodnota je. Skúšané na dátumoch.

OT: Ty vole, to je román presne ako som predpokladal ... ani som to nedočítal.

No, tých problémov tam je strašne veľa. Nemôže Vám to samé doplniť kraj, keď nemáte zoznam všetkým miest a obcí a im prislúchajúcich krajov pekne v tabuľke, a z nej sa to doplní. Dalo by sa to riešiť aj tak, že by sa vždy porovnala napísaná obec (bolo by dovolené nielen vybrať existujúcu ale aj zadať novú), a ak by sa našla, zakázalo by to zmenu kraju a doplnilo ho, no ak by nenašlo, povolilo by nastavenia kraja z možností, ktoré sú pevné. Technických problémov tam bude treba riešiť fakt veľa. Od kontroly číselných údajov v číselných údajoch, cez zabezpečenie neduplicitného vykonávania procedúr (jedna operácia ovplyvňuje druhú a opačne, napr. zaškrtávacie polia), ďalej napr. ošetrenie krajných indexov (1. a posledný), pričom za posledný sa dá ísť ale už to bude ako pridanie nového záznamu, atď. Treba zabezpečiť rozlíšenie nového záznamu a editáciu starého, možnosť skočiť na záznam s nejakým indexom (nielen po jednom), pri odstránení záznamu poprehadzovať poradové čísla ... Je toho veľa, pozeral som nato. Nečudujte sa, že sa nikto nepredháňa...

Nastavenie premennej nieje možné pri jej deklarácii. Použite na to Metódu zošitu Workbook_Open(). Ak chcete uchovať premennú aby bola nastavená pri otvorení tá ktorá bola pri poslednom zatvorení a uložení zošitu, tak si na to vytvorte jeden list s Visible=xlSheetVeryHidden, kde si budete ukladať zmysluplné hodnoty takýchto premenných. Zmysluplné píšem preto, že tam nemôžete uložiť premennú typu Object, napr. Worksheet, ale textový názov listu, teda jeho .Name.
Inak platí, že kdekoľvek v makre nastavíte Public premennej hodnotu, táto hodnota je dostupná v celom VBA aj v UserForm.

Tu máte zmenenú verziu, nielen od 12. riadku, ale aj predpokladám potrebu uchovania tých 11 riadkov nad tým, a zároveň upravený proces zoradenia.

A čo tam chcete vyčarovať s tými ostatnými makrami ?

Keď na to ešte tak pozerám, pridajte na koniec tohto riadku:
If Z = False Then Col.Add Array(Datum, i)
ešte ", CStr(i)", teda:
If Z = False Then Col.Add Array(Datum, i), CStr(i)

Možno aj takto, ale pozor, používa sa rovnako veľká oblasť vpravo, kde sa premiestnia zoradené oblasti, a pôvodné stĺpce (už bez oblastí) sa celé zmažú. Vyskúšajte.

Sub ZoradSkupiny()
Dim Col As Collection, Riadkov As Long, Skupin As Long, i As Long, c, Datum As Date, Dat(), Z As Boolean, OldRng As String

Set Col = New Collection
With ThisWorkbook.ActiveSheet
Riadkov = .Cells(Rows.Count, 2).End(xlUp).Row + 2
Skupin = Riadkov \ 9
If Riadkov / 9 <> Skupin Then MsgBox "Oblasti niesú rovnomerné! Koniec.": Exit Sub
ReDim Dat(1 To Riadkov, 1 To 1)
Dat = .Cells(1, 12).Resize(Riadkov).Value

For i = 1 To Skupin
Datum = Dat((i - 1) * 9 + 3, 1)
Z = False
If Col.Count > 0 Then
For Each c In Col
If c(0) > Datum Then Col.Add Array(Datum, i), Before:=CStr(c(1)): Z = True: Exit For
Next c
If Z = False Then Col.Add Array(Datum, i), CStr(i)
Else
Col.Add Array(Datum, i), CStr(i)
End If
Next i

With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual: End With
OldRng = Selection.Address
.Cells(1, 1).Resize(, 13).Copy
.Cells(1, 14).Resize(, 13).PasteSpecial Paste:=xlPasteColumnWidths

Riadkov = 0
For Each c In Col
.Cells((c(1) - 1) * 9 + 1, 1).Resize(9, 13).Cut
.Cells(Riadkov * 9 + 1, 14).Resize(9, 13).Insert Shift:=xlDown
Riadkov = Riadkov + 1
Next c

.Columns(1).Resize(, 13).EntireColumn.Delete

With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic: End With
.Range(OldRng).Select
End With

Set Col = Nothing
End Sub

Tak?

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje