Příspěvky uživatele
< návrat zpět
Potrebujete skutočne použiť Copy+Paste? Potrebujete aj vyfarbenie, orámovanie a pod? Nestačili by Vám iba hodnoty v bunkách? V 99,9% prípadov je to tak. Potom by bolo získanie hodnôt rýchlejšie či už makrom alebo s PowerQuery.
Príklad.
A ako pätu si dajte tie Vaše údaje ako obrázok.
Maticový Ctrl+Shift+Enter od Office 2019 je funkcia TEXTJOIN:
=IF(COUNTIF($B$2:$B$10;B2)=1;"";TEXTJOIN(", ";TRUE;IF(($B$2:$B$10=B2)*($A$2:$A$10<>A2);$A$2:$A$10;"")))
=KDYŽ(COUNTIF($B$2:$B$10;B2)=1;"";TEXTJOIN(", ";PRAVDA;KDYŽ(($B$2:$B$10=B2)*($A$2:$A$10<>A2);$A$2:$A$10;"")))
Hľadanie pomocou Collection bude veľmi rýchle. Ale ako chcete používať akékoľvek hľadanie kódu a ID, ak je to plné dupiel (pod jedným kódom sú rôzne ID) ?
Sub CollectionLookup()
Dim Data(), ID(), Kod(), Col As New Collection, i As Long, RowsData As Long, RowsExport As Long
RowsExport = wsEXPORT.Cells(Rows.Count, "D").End(xlUp).Row - 1
If RowsExport = 0 Then MsgBox "Chýbajú kódy v EXPORT.", vbExclamation: Exit Sub
If RowsExport = 1 Then ReDim Kod(1 To 1, 1 To 1): Kod(1, 1) = wsEXPORT.Range("D2").Value2 Else Kod = wsEXPORT.Range("D2").Resize(RowsExport).Value2
ReDim ID(1 To RowsExport, 1 To 1)
RowsData = wsData.Cells(Rows.Count, "A").End(xlUp).Row - 1
If RowsData = 0 Then MsgBox "Chýbajú data.", vbExclamation: GoTo KONIEC
Data = wsData.Range("A2:B2").Resize(RowsData).Value2
On Error Resume Next
For i = 1 To RowsData
Col.Add Data(i, 2), CStr(Data(i, 1))
Next i
For i = 1 To RowsExport
ID(i, 1) = Col(CStr(Kod(i, 1)))
Next i
On Error GoTo 0
KONIEC:
wsEXPORT.Range("A2").Resize(RowsExport).Value2 = ID
Set Col = Nothing
End Sub
Ja by som obmedzil početnosť výpisu na nejaké "skoky". Inak sa totiž ľahko stane, že bude makro rýchlejšie ako je schopné sa prekresľovať okno či prvok.
Odkaz je platný, ale do mojej schránky SZ 
To som páchal ja. Ktorý to je topic, nech si pohľadám celý súbor ? Alebo mi pošlite aktuálny súbor.
Nič nesľubujem, musí to byť na desiatky minút, inak končím. Som dlhodobo chorý...
Ak je to 2 rozmerné pole, potrebujete Transpose (v tomto prípade bez premennej - podľa potreby prípadného ďalšieho spracovania...).
Sheets(Application.Transpose(Sheets("List1").Range("A1:A3"))).Copy
Ak je množstvo listov dynamické, teda môže nastať 1, tak to do poľa neprejde. To treba ošetriť. Ak môže nastať, že bude medzi bunkami prázdna, či neexistujúci list, to treba ošetriť...
Funkčné makro - zdroj.
Za výkonným riadkom dajte
DoEvents
Ale pozor ! Veľmi to spomaľuje !
Ak je príloha XLSM, musí byť zabalená v ZIP.
celá označená oblasť
Sub Posun()
Selection.Offset(3, 6).Select
End Sub
prvá bunka označenej oblasti
Sub Posun()
Selection.Cells(1).Offset(3, 6).Select
End Sub
Súbor - Možnosti - Doplnky - Spustiť - Analytické nástroje - OK
Vy kopírujete bunku, preto to tak robí. Vzorec kopírujte a vkladajte v riadku vzorcov.
Použite výpočet inak. Mod vo VBA nie je to isté ako MOD v Exceli. Môžete použiť aj vyremované vypínanie Events
'Dim DisableEvent As Boolean
Private Sub TextBox1_Change()
'If DisableEvent Then Exit Sub
Zmena
End Sub
Private Sub TextBox2_Change()
'If DisableEvent Then Exit Sub
Zmena
End Sub
Private Sub TextBox3_Change()
'If DisableEvent Then Exit Sub
Zmena
End Sub
Sub Zmena()
Dim zac As Date, kon As Date
On Error Resume Next
zac = TimeValue(Me.TextBox1.Value)
kon = TimeValue(Me.TextBox2.Value)
Me.TextBox4.Value = MODX(kon - zac, 1) * 24 - (Me.TextBox3.Value / 60)
If Err.Number <> 0 Then Me.TextBox4.Text = ""
End Sub
Private Sub UserForm_Initialize()
'DisableEvent = True
Me.TextBox1.Value = "22:00"
Me.TextBox2.Value = "06:00"
'DisableEvent = False
Me.TextBox3.Value = "30"
End Sub
Function MODX(Cislo As Double, Del As Integer) As Double
MODX = Cislo - Del * Int(Cislo / Del)
End Function
Na označenie buniek rovnakou farbou za rovnakých podmienok ako bunka s dátumom (či sobotou) môžete použiť predsa rovnaký Podmienený formát. V makre použite na zistenie "farby" (nezisťujte priamo farbu, ale splnenie podmienky na zafarbenie) rovnaký princíp ako v Podmienenom formáte. O tomto hovorí užívateľ r13.
Je možné použiť aj spešl metódu na zistenie výslednej farby Podmieneného formátovania, pomocou Evaluate a DisplayFormat.
Čo ale potrebujete z textu nie je vôbec zrejmé.
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články