"Žádné" omezení tam není. Buď provádíte manuální úpravu kódu chybně nebo je v oblasti pro NR=65 a větší něco, co vás omezuje. Bez přílohy ovšem jen tipuji.
Pokud nechcete pro každé NR řešit úpravu obastí, proveďte to přes Offset + Resize. Poté zadáte velikost oblasti jen na jednom místě. Také zápis na buňku pod a poté posun nahoru je zbytečný - spouštíte 1 rekalkulaci navíc.
Něco takovéhoSub subCombining()
Const ciRECORDS_NUMBER As Long = 100
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Cells(2, 1).Resize(ciRECORDS_NUMBER, 1)
If iLastRow < .Row Then
iLastRow = .Row - 1
End If
If iLastRow < .Row + ciRECORDS_NUMBER - 1 Then
.EntireColumn.Cells(iLastRow + 1).Value = Range("F13").Value
Else
.Resize(ciRECORDS_NUMBER - 1, 1).Value = .Offset(1, 0).Resize(ciRECORDS_NUMBER - 1, 1).Value
.Cells(ciRECORDS_NUMBER, 1).Value = Range("F13").Value
End If
End With 'Cells(2, 1).Resize(ciRECORDS_NUMBER, 1)
End SubJe to jen v rychlosti a fungovalo to u mne správně. Sám bych to asi napsal úplně jinak, ale na tom teď nezáleží.
eLCHa myslel obyčejné MSQuery, které dBase podporuje. S vypsáním sloupců v pořadí, jaké potřebuji. Buď s VBA nebo bez (pokud se počet sloupců může měnit, tak asi s)
Dim sSql As String
sSql = "SELECT t.CUST_NO, t.NAME, t.STREET, t.CITY, t.STATE_PROV, t.ZIP_PST_CD, t.COUNTRY, t.PHONE, t.FRST_CNTCT FROM `D:\Downloads`\Sample.dbf t"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:="ODBC;DSN=dBASE Files;PageTimeout=0;", Destination:=Cells(1)).QueryTable
.CommandText = sSql
.Refresh BackgroundQuery:=False
End With
http://wall.cz/index.php?m=topic&id=30273&addpost&page=1
jde všechno, vždy jde jen o použitelnost.
Private Sub UserForm_Initialize()
Dim rData As Range
Set rData = Range("D11:F11,H13:J13")
Dim rArea As Range, rCell As Range
For Each rArea In rData.Areas
For Each rCell In rArea.Cells
ComboBox1.AddItem rCell.Value
Next rCell
Set rCell = Nothing
Next rArea
Set rArea = Nothing
Set rData = Nothing
ComboBox1.ListIndex = 0
End Sub
proč je lepší použít .list míst .rowsource
Není to lepší, je to jen jiné. RowSource očekává objekt typu Range, jenže vy potřebujete objekt typu pole, který vrací Transpose. Ten vložite do List.
tento kód nefunguje, pokud není aktivní list "Týmy" (runtime error 1004):
Protože pokud použijete nespecifikované Range, Cells atp., tak se vždy berou buňky z aktivního listu aktivního sešitu . Takže musíte specifikovat list pro všechny tyto objekty, např. pomocí With
With Worksheets("Týmy")
arrPolePolozek = WorksheetFunction.Transpose(.Range(.Cells(5, 1), .Cells(5, 3)))
End Withnebo použijte ResizearrPolePolozek = WorksheetFunction.Transpose(Worksheets("Týmy").Cells(5, 1).Resize(1, 3))
Jakým způsobem importujete? Pokud pomocí sql, tak si pořadí sloupců definujte v dotazu.
@DAAL
něco takového by mělo stačitSub test()
Dim rCell As Range
For Each rCell In Sheets("seznam").Range("B2:B11").Cells
If Not IsError(Evaluate("='" & rCell.Value & "'!A1")) Then
Sheets(rCell.Value).Range("B1:B4").Locked = True
End If
Next rCell
Set rCell = Nothing
End SubSamozřejmě máte pravdu, bez zamknutí listu nemá zamknutí buněk celkem smysl. Nicméně to nebylo součástí dotazu a tak předpokládám, že si to OP dořeší sám.
Rozumím tomu, že je to seznam listů. Takže buď projede všechny listy nebo všechny buňky. Takže se bez cyklu neobejde. Vzhledem k malému počtu položek to na rychlost asi nemá vliv. "Rychlejší" bude asi druhá možnost, prakticky je to asi jedno.
No, to taky. Ale hlavněi = Sheets("seznam").range("b2:b4")načítá pole a protoi = ws.Namemusí házet chybu.
Zkuste něco takovéhoSub subZamknout()
Dim ws As Worksheet
For Each ws In Worksheets
If Not ws.Name = "seznam" Then
If Not WorksheetFunction.CountIf(Sheets("seznam").Range("b2:b4"), ws.Name) = 0 Then
ws.Range("B1:B4").Locked = True
End If
End If
Next ws
Set ws = Nothing
End Sub
Chová se to tak, že mezi jednotky a desítky vložím čárku. Nejedná se o desetinnou čárku, ale o znak ",". Pokud byste tedy chtěl ty centimetry na 2 desetinná místa nebo více, tak to nelze, protože tam už se jedná o desetiny milimetru., které jsou v "originále" za desetinou čárkou a vždy budou odděleny desetinnou čárkou.
Takže pro 12,35 by formát0","0,00dal takovéto ošklivé 1,2,35.
Pro 123 by0","00 dalo 1,23 a to by byl ekvivalent dm, protože by čárka byla vložena mezi desítky a stovky
Nevím, jestli jste z toho chytřejší, ale jiné vysvětlení mne nenapadá.
Pokud je zadáváno v mm tak.[<10]0,0" mm";[<1000]0","0" cm";0,0 " m"Máte tam sice <100, ale já dal <1000 - protože formát umí "dělit" jen násobkem tisíců
1456 => 1,5 m
356 => 35,6 cm
12 => 1,2 cm
136 => 13,6 cm
12,5 => 1,3 cm
Možná jsem mimo, ale nechce se mi to číst. Takže se případně omlouvám.
Donedávna jsem používal soubor, u kterého jsem potřeboval sledovat změny. Obsahoval desetitisíce vzorců a tento log mne absolutně nezdržoval, protože všechno šlo mimo zápis do jakéhokoliv listu - tedy nebyla spuštěna rekalkulace. Data jsem udržoval v listboxu a pokud došlo k uložení sešitu, zapsal jsem je do souboru csv. Pokud k uložení nedošlo - data byla zapomenuta.
Jen tak z legrace - zkusil jsem totoFunction DATE_STAMP() As Date
Application.Volatile
If Sheets("List1").ProtectContents Then
DATE_STAMP = Sheets("List1").Range("A1").Value
Else
DATE_STAMP = Date
End If
End Functiona pak =DATE_STAMP() do A1. Pokud je list zamčený, hází to cyklický odkaz, což je naprd.
Ale toto mi funguje:
Do listu Excel4Macro vložit do buňky A1 toto=STÁLE.PŘEPOČÍTÁVANÁ()
=VÝSLEDEK(1)
=NÁVRAT(KDYŽ(O.DOKUMENTU(7; "List1");List1!A1;DNES()))
do List1!A1 vložit=Makro1!A1()
Tzn - datum se v buňce A1 změní pouze když je list odemknutý při přepočtení listu ;))
Pokud by to chtěli zkusit slováci:=VOLATILE()
=RESULT(1)
=RETURN(IF(GET.DOCUMENT(7; "List1");List1!A1;TODAY()))
Nevím, zda to musíte dělat kódem, ale já používám
CTRL+H:
Najít: 0
Nahradit: prázdné
Možnosti: Zaškrtnout Pouze celé buňky
Nelze - z důvodu bezpečnosti.
Řeší se to tak, že se v případě nepovolených maker sešit znefunkční. Většinou je při uložení přepnut na list s textem: Nemáte povolena makra, bla bla bla. Pokud jsou makra povolena, tento list je kódem skryt a sešit zpřístupněn.
Další možnost je otevření sešitu např. přes ty Vaše vbs a v nich provést ony automatické úpravy. Sešit by se pak musel vždy otevírat tímto "zástupcem" a nemusel by obsahovat žáden kód
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.