To by som riešil asi cez vlastný Type:
Public Type TZaznam
Nazev As String
Ucet As Variant
End Type
Sub Test2()
Dim VZZ_nazev() As TZaznam, k As Byte, x As Byte, b As String, Ucet As Long
ReDim VZZ_nazev(3)
VZZ_nazev(0).Nazev = "vyrobky": VZZ_nazev(0).Ucet = Array(601000, 601001, 601002, 601010, 611300)
VZZ_nazev(1).Nazev = "sluzby": VZZ_nazev(1).Ucet = Array(501515, 501640)
VZZ_nazev(2).Nazev = "tzbozi"
VZZ_nazev(3).Nazev = "nzbozi"
Ucet = 601000
For k = 0 To UBound(VZZ_nazev)
If IsArray(VZZ_nazev(k).Ucet) Then
For x = 0 To UBound(VZZ_nazev(k).Ucet)
If Ucet = VZZ_nazev(k).Ucet(x) Then
b = "OK"
End If
Next x
End If
Next k
End Sub
Presne tak, iba R1C1. Tiež som to riešil včera tu (5. metóda):
http://wall.cz/index.php?m=topic&id=29155&page=2#post-30230
Ale vo Vašom prípade netuším prečo to musí byť makrom. Urobte si definíciu názvu Cargo:
=Cargo!$AB$1:INDEX(Cargo!$AB:$AB;COUNTA(Cargo!$AB:$AB)+1)
Veď Vy to tak defacto aj máte, lebo v AB25 máte počtový vzorec, len to zbytočne preháňate cez makro. AB25 zmažte, a nechajte si len vzorec, ktorý som uviedol, alebo ak viete, že neprekročíte napr. 25 riadkov, tak počítanie obmedzte takto:
=Cargo!$AB$1:INDEX(Cargo!$AB$1:$AB$25;COUNTA(Cargo!$AB$1:$AB$25)+1)
EDIT:
Upravil som Vám tie makrá. Oblasť mien je nastavená na 20 riadkov. Viď príloha. Ale netuším, čo majú robiť niektoré makrá vo formulároch...
Takúto techniku som používal kedysi v Delphi, už som na to aj zabudol. Pripomenul ste mi to, ďakujem.
Áno je to udalosť zošitu (nie listu):
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Máličko upravené od kolegu. Odporúčam, aby ste si nastavili v makre v procedúre listu Worksheet_BeforeDoubleClick, hodnotu Oblast tak, aby sa formulár neotváral úplne hocikde. Mohlo by to viesť k nechcenému otváraniu pri vstupe do akejkoľvek bunky. Teraz som nastavil reagovanie od A1:C100.
Ešte by som tam asi testoval, či stojíte v korektnej zdrojovej oblasti, a či je skok uskutočniteľný. A bez Selectu, za ktorý sa tu kameňuje
Sub HladajBunku()
Dim hledej, Najdene
If Not Intersect(ActiveCell, Range("A1:H10")) Is Nothing Then
hledej = ActiveCell
With Sheets("SUM1")
Set Najdene = .Cells.Find(What:=hledej, After:=.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
If Not Najdene Is Nothing Then Application.Goto Najdene, True
End If
End Sub
Určite by to šlo nejako odborne. Zatiaľ tu máte jeden MEGAvzorec. Ku skóre, či čo to je, pripočíta 1 ak má tým vzájomný zápas lepší. Počíta sa ale iba s prípadom, že bude skóre rovnaké u 2 týmov. Upravil som teda aj stĺpec s RANK na tento nový počet.
Čitateľnosť/upraviteľnosť takéhoto vzorca je ale prakticky nulová
dontom napsal/a:
...vidíte v tom vzorci nějakou chybu?
=SOUČIN.SKALÁRNÍ((MOD(SLOUPEC($N$4:$BFP$4);5)=0)*($N$4:$BFP$4))
Veľmi podobný vzorec ako kolega nadomnou:
=IF(SUM(--ISNUMBER(FIND({"a.s";"r.o"};$A1)))>0;"Právnická osoba";"Fyzická osoba")
=IF(SUMA(--JE.ČISLO(NAJÍT({"a.s";"r.o"};$A1)))>0;"Právnická osoba";"Fyzická osoba")
Urobil som Vám také porovnanie niekoľkých spracovaní, 2 porovnávacie, a 3 spracované na námet eLCHa. Tá posledná sa mne páči najviac. Nielen, že nemá problém so znakmi (ani ostatné na námet eLCHa), ale je aj rýchla.
PS: Nejak sa mi nedarí do porovnávacích stringov pre metódy 2 a 3 pridať hentie "bazmekznaky" ani cez StrConv. Asi som už úplne vypatlaný. Dajte nejaký návrh, doplním ich tam.
@hard, Ak to je ešte aktual, tak pošlite prílohu.
EDIT: Naozaj neviem, o čo ide, ja kopírujem data do iného zošitu normálne. viď príloha.
Nedávno som posielal na iné fórum zaujímavý variant pre N-té slovo.
=TRIM(RIGHT(LEFT(SUBSTITUTE(B1;B2;REPT(" ";LEN(B1)));B3*LEN(B1));LEN(B1)))
=PROČISTIT(ZPRAVA(ZLEVA(DOSADIT(B1;B2;OPAKOVAT(" ";DÉLKA(B1)));B3*DÉLKA(B1));DÉLKA(B1)))
Od eLCHa samozrejme funguje tiež. Prihodil som ho do súboru s úpravou voliteľného oddeľovača.
Ak to bude vzorcami tak si overte či ten "jiný program" zožerie tie 0 (nuly) ktoré vzniknú ťahaním prázdnej bunky vzorcom. Ak nie tak vzorce upravte takto:
=IF('[Packing List.xlsm]LIST'!A9=0;"";'[Packing List.xlsm]LIST'!A9)
=KDYŽ('[Packing List.xlsm]LIST'!A9=0;"";'[Packing List.xlsm]LIST'!A9)
Ak to chcete makrom, tak by som nepoužil nahrávanie makra ale niečo takéto:
Sub Kopiruj()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Workbooks.Open Filename:=ThisWorkbook.Path & "\Data.xls"
.DisplayAlerts = True
With Workbooks("Data.xls")
.Worksheets("Data").Cells(2, 1).Resize(16, 6).Value = ThisWorkbook.Worksheets("LIST").Cells(9, 1).Resize(16, 6).Value
.Close SaveChanges:=True
End With
.ScreenUpdating = True
End With
End Sub
A načo tam máte zlúčené bunky, keď ich evidentne nepotrebujete ?
Presne tak, pozor na presný názov listu, Select, Aktivate a pod. Ale ak používate viac naraz otvorených zošitov, tak v makre pridajte pred ThisWorkbook.Worksheets(... pre istotu.
A najlepšie hodte nám do pľacu tie makrá a súbory...
No veď práve to je problém na ktorý som narazil a neviem ho rozlúsknuť (ak vôbec nejako pôjde). Chcel som použiť na prevod vloženie do pomocnej bunky ako FormulaLocal a prečítanie ako Formula, čím sa vzorec preloží a dá sa potom vypočítať cez EVALUATE. Lenže zmena inej bunky vo funkcii nefunguje. Funkcia môže meniť bunku iba v jedinom prípade, ak je volaná z procedúry. Ale priamo, akonáhle by bola táto fnc volaná z proc volanej z fnc, už to opäť nefunguje. Skúsil som vytvoriť aj Class, ktorá mala meniť bunku, v nádeji, že ak je to Class (Object) tak zdedí Range so všetkým. Akonáhle ale prebieha interná procedúra v triede tak na riadku kde má zapísať do bunky, to vyvolá okamžite Class_Terminate, a bez chybovej hlášky.
Zatiaľ jediné riešenie ma napadá spúšťať výpočet tlačítkom, to fungovať bude.
Alebo mať schovaný list s bunkami s rovnakými vzorcami ako vo formátovaní.
Alebo rovnaké kontrolné mechanizmy implementovať do UDF. Teda prepísať vzorce do VBA.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.