Příspěvky uživatele
< návrat zpět
Váš prvý kód otvára zošit adresa.xls (tam má byť celá cesta) a do neho vloží data zo zošitu, v ktorom spúšťate makro.
Ale teraz podľa posledného kódu je náznak, že to môže byť aj opačne. Že chcete kopírovať z toho otváraného. Aj keď ten posledný kód je zlý, ak to spúšťate z modulu skopíruje data z aktívneho listu aktívneho zošitu, a to bude po otvorení predsa práve ten otvorený súbor. Pred Range chýba vlastník.
Každopádne nebudem špekulovať, čo asi chcete ako urobiť z Vašich nefunkčných kódov. Napíšte odkiaľ sa má kopírovať (súbor + list), a kam sa má kopírovať (súbor + list). Ďalej či sú oblasti rovnaké, či sú nemenné, alebo či treba zisťovať ich veľkosť (lebo v kódoch používate rôzne oblasti).
Bez skúšania od boku
Dim w As Workbook 'A
Set w = Workbooks.Open(Filename:="adresa.xls")
w.Sheets("zpian").Range("A1:AC9999").Value=ThisWorkbook.Sheets("Zpian").Range("A1:AC9999").Value
w.Close SaveChanges:=True
Set w = Nothing
Treba urobiť tieto veci:
1. Spoločné unifikované obslužné procedúry do normálneho modulu:
Sub CMD_Button_Click(ByRef cb As ComboBox) 'Vyhledání slova ze sloupce JMÉNO
Dim rng As Range, rngSource As Range, rngDest As Range, LOsource As ListObject
Set LOsource = cb.Parent.ListObjects(1) 'Načítanie 1. Tabuľky v liste, na ktorom je volacie tlačítko
Set rng = LOsource.ListColumns("jméno").DataBodyRange.Find(What:=cb.Text)
If Not rng Is Nothing Then
Set rngSource = LOsource.Range.Rows(rng.Row) 'Zdrojový riadok
Set rngDest = Worksheets("KOŠ").Cells(1, 1).End(xlDown) 'Cieľový riadok
rngDest.Offset(IIf(IsEmpty(rngDest), 0, 1), 0).Resize(, rngSource.Columns.Count).Value = rngSource.Value 'Zápis zdrojového riadku na cieľový s ošetrením posunu riadku, ak bola cieľová tabuľka iba s 1 riadkom
rngSource.Delete Shift:=xlShiftUp 'Výmaz zdrojového riadku
cb.Text = vbNullString 'Vymaže obsah ComboBox1
Set rng = Nothing: Set rngSource = Nothing: Set rngDest = Nothing: Set LOsource = Nothing
End If
End Sub
Sub CB_Refresh(ByRef cb As ComboBox) 'Znovuvyplnenie ComboBoxu pri jeho aktivácii
cb.ListFillRange = cb.Parent.Range("ZOZNAM").Address(, , , True)
End Sub
2. Samostatné definované názvy "ZOZNAM" pre List (!) nie pre Zošit.
3. V každom module listu:
Private Sub ComboBox1_GotFocus() 'Aktualizácia zoznamu ComboBox1 - Každý list má svoj definovaný názov ZOZNAM
CB_Refresh ComboBox1
End Sub
Private Sub CommandButton2_Click() 'Volanie spoločnej procedúry kliknutia
CMD_Button_Click ComboBox1
End Sub
Teda z toho vyplýva, že zmažete ZOZNAM pre Zošit. Vytvoríte rovnaký ZOZNAM ale pre jeden List. Do modulu toho listu dáte tie 2 volacie krátke procedúry. A nakoniec do normálneho modulu dáte tie 2 obslužné procedúry. Ak tento list potom duplikujete, automaticky bude fungovať, lebo si sám vytvorí vlastný ZOZNAM odkazujúci na jeho Tabuľku.
Predpoklady na fungovanie:
-listy si vytvorte nanovo z toho jedného upraveného
-objekty sa musia volať rovnako na každom liste
-daná Tabuľka musí byť ako prvá v liste (najlepšie jediná)
Private Sub ComboBox1_GotFocus()
'Aktualizácia zoznamu ComboBox1
ComboBox1.ListFillRange = Range("ZOZNAM").Address(, , , True)
End Sub
Private Sub CommandButton2_Click()
'Vyhledání slova ze sloupce JMÉNO
Dim rng As Range, rngSource As Range, rngDest As Range, LOsource As ListObject
Set LOsource = ListObjects("Tabulka1")
Set rng = LOsource.ListColumns("jméno").DataBodyRange.Find(What:=ComboBox1.Text)
If Not rng Is Nothing Then
'Zdrojový riadok
Set rngSource = LOsource.Range.Rows(rng.Row)
'Cieľový riadok
Set rngDest = Worksheets("KOŠ").Cells(1, 1).End(xlDown)
'Zápis zdrojového riadku na cieľový s ošetrením posunu riadku, ak bola cieľová tabuľka iba s 1 riadkom
rngDest.Offset(IIf(IsEmpty(rngDest), 0, 1), 0).Resize(, rngSource.Columns.Count).Value = rngSource.Value
'Výmaz zdrojového riadku
rngSource.Delete Shift:=xlShiftUp
' Vymaže obsah ComboBox1
ComboBox1 = vbNullString
Set rng = Nothing: Set rngSource = Nothing: Set rngDest = Nothing: Set LOsource = Nothing
End If
End Sub
a Definovaný názov ZOZNAM
=OFFSET(Tabulka1[jméno];;;LOOKUP(2;1/(Tabulka1[jméno]<>"");ROW(Tabulka1[jméno])-1))
=POSUN(Tabulka1[jméno];;;VYHLEDAT(2;1/(Tabulka1[jméno]<>"");ŘÁDEK(Tabulka1[jméno])-1))
Oblasti v oboch zošitoch sú rovnaké? Nie sú tam zlúčené iné bunky, alebo na iných miestach?
Skúste zameniť xlAdd za xlPasteSpecialOperationAdd.
A určite chcete hodnoty pridávať k predošlým?
Veď to A2 som Vám tam nahradil daným vzorcom. A ani pre Vás nemôže byť predsa problém si nahradiť v texte každý výskyt subtextu iným textom - teda adresu bunky vzorcom. Ak si pozriete moju poslednú prílohu tak v stĺpci AC je presne ten Váš požadovaný vzorec, ako jeden z dvoch možných variantov. Tak si len vzorec prehoďte z AC do F. Ale kopírujte iba vzorec, nie bunku.
Vidím, že v legende sa počíta s chybou (text ##### - chyba NEDOSTUPNÝ). Aj stĺpec UL. Takže aj v stĺpci MIX sa má zobraziť "#####" ak nenájde v Zpian? Alebo má byť potom bunka ="" ?
Makro na počítanie farby .... moje nervy, čo týždeň, to chce niekto spočítavať počet farieb. Na to Excel nieje stavaný. Zmena farby nespôsobí prepočet vzorcov, a teda na to ani makro nereaguje. Mám rozpracovanú celkom sľubnú metódu, ktorá by mala reagovať na zmenu farby, bez potreby niekam klikať, no zatiaľ nefunguje správne. Zmierte sa s potrebou aktualizácie počtu. Akurát asi nieje potrebné aby sa volala vo Vašom prípade makro funkcia pre každú bunku, ale iba jedna pre celý rozsah A5:A34 a pre všetky 3 farby naraz, a len do 1 bunky C35. Mám to tak urobiť?
EDIT: To s vypísaním chyby som pridal do stĺpca AC.
Makro som zmenil, Indexov farieb môžete do funkcie zadať variabilný počet. Tlačítko aktualizuje počet. Ak ste indexy farieb nepoužívali aj na niečo iné, stĺpec B nieje potrebný.
Perfiš. A aj to sa dá zjednodušiť a odmaticovieť:
=IF(ISNUMBER(A2);A2/10^(MATCH(0;MOD(A2;10^{0;1;2;3}))-1);"")
=KDYŽ(JE.ČISLO(A2);A2/10^(POZVYHLEDAT(0;MOD(A2;10^{0;1;2;3}))-1);"")
Namiesto tej 0 vo funkcii MAX tam dajte ešte obmedzenie
...
LEN(VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0))-3
...
EDIT:
Ak tomu dobre rozumiem, malo by stačiť podľa inšpirácie marjankaj aj kratšie:
=IF(ISBLANK(B5);" "; VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0)/10^(3-MAX(0;LEN(VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0)/10^3)-5)))
=KDYŽ(JE.PRÁZDNÉ(B5);" "; SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0)/10^(3-MAX(0;LEN(SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0)/10^3)-5)))
Teda pre názornosť marjankajov vzorec po úprave:
=A1/10^(3-MAX(0;LEN(A1/10^3)-5))
=A1/10^(3-MAX(0;DÉLKA(A1/10^3)-5))
opravte ma prosím ak sa mýlim.
EDIT 2:
Tak opravujem sa sám, môj predošlý vzorec je na prd, vracia zlé výsledky, ak je číslo bez núl kratšie ako 7 alebo ak je číslo s nulami kratšie ako 5.
každopádne Marjankajove riešenie funguje bezchybne. Upravené iba na 3 nuly:
=A1/10^LEN(A1)*10^MAX(LEN(A1)-3;LEN(A1/10^LEN(A1))-2)
=A1/10^DÉLKA(A1)*10^MAX(DÉLKA(A1)-3;DÉLKA(A1/10^DÉLKA(A1))-2)
Teda Váš vzorec bude
=VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0)/10^LEN(VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0))*10^MAX(LEN(VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0))-3;LEN(VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0)/10^LEN(VLOOKUP(B5; Zpian!$F$6:$AC$10001;5;0)))-2)
=SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0)/10^DÉLKA(SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0))*10^MAX(DÉLKA(SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0))-3;DÉLKA(SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0)/10^DÉLKA(SVYHLEDAT(B5; Zpian!$F$6:$AC$10001;5;0)))-2)
Končím "výskum" 
Tu je teda jedno z riešení.
OT:No vidím, že sme včera viacerí "nemali čo v noci robiť" :) Ja som pri tom zaspal. keď som sa zobudil, v bunke napísaných asi 200 písmen "C" 
Komentáre som písal v polospánku, teraz som ich ráno skontroloval, no čo som tam preklepov nasekal, evidentne som už na to nevidel. Teraz by v nich snáď mali byť už len gramatické chyby, lebo česká gramatika mi robí niekedy problém.
Maticový vzorec ? (Ctrl+Shift+Enter)
=INDEX(N1:N7&","&O1:O7;MATCH(MAX(COUNTIFS(N1:N7;N1:N7;O1:O7;O1:O7));COUNTIFS(N1:N7;N1:N7;O1:O7;O1:O7);0))
=INDEX(N1:N7&","&O1:O7;POZVYHLEDAT(MAX(COUNTIFS(N1:N7;N1:N7;O1:O7;O1:O7));COUNTIFS(N1:N7;N1:N7;O1:O7;O1:O7);0))
Poskytnite aspoň čiastočný súbor, kde budú tie 2 listy, nejakých pár vymyslených údajov. Citlivé data nepotrebujeme. Ale presné rozloženie áno. To sa bez prílohy robí veľmi zle, navyše keď ako sám vravíte, to Vaše makro nemusí byť vôbec smerodajné, čo sa týka určenia pohyblivých častí adries.
@ Tom12345 :
Dajte si do pomocnej bunky
=B2&CHAR(10)&B3&CHAR(10)&B4&CHAR(10)&B5&CHAR(10)&B6&CHAR(10)&B7&CHAR(10)&B8&CHAR(10)&B9&CHAR(10)&B10
=B2&ZNAK(10)&B3&ZNAK(10)&B4&ZNAK(10)&B5&ZNAK(10)&B6&ZNAK(10)&B7&ZNAK(10)&B8&ZNAK(10)&B9&ZNAK(10)&B10
alebo v nových Office 2019
=TEXTJOIN(CHAR(10);TRUE;B2:B10)
=TEXTJOIN(CHAR(10);PRAVDA;B2:B10)
a v textovom poli sa odkazujte na túto pomocnú bunku. S pomocou CHAR(10) budú pod sebou, s pomocou napr. "," budú oddelené čiarkou za sebou.
=INDEX(D20:O20;;LOOKUP(2;1/(D33:O33<>0);COLUMN(D33:O33)-3))
=INDEX(D20:O20;;VYHLEDAT(2;1/(D33:O33<>0);SLOUPEC(D33:O33)-3))
alebo
=INDEX(D20:O20;;LOOKUP(2;1/(D33:O33<>0);{1\2\3\4\5\6\7\8\9\10\11\12}))
=INDEX(D20:O20;;VYHLEDAT(2;1/(D33:O33<>0);{1\2\3\4\5\6\7\8\9\10\11\12}))
analogicky urobíte aj ten vertikálny:
=INDEX(C21:C32;LOOKUP(2;1/(P21:P32<>0);{1;2;3;4;5;6;7;8;9;10;11;12}))
=INDEX(C21:C32;VYHLEDAT(2;1/(P21:P32<>0);{1;2;3;4;5;6;7;8;9;10;11;12}))
To je predsa pre to, že to makro, ako som napísal, je robené na data, ktoré UŽ MAJÚ PRIDANÝ STĹPEC "N" "Inštrumentárka". Teda pri preformátovaní sa odoberie všetkému formát pomocou ClearFormats, a následne sa nastaví pre potrebné stĺpce formát času. Tak ste to aj mala, len som to posunul, lebo je tam pridaný stĺpec "N". Teda na čas sa preformátuje O:W. Nie N.
Tak aké je teda rozloženie stĺpcov?
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články