Příspěvky uživatele
< návrat zpět
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é.
Ani toto nepomôže?:
"[$-405]dd.mm.yy hh:mm"
Verzia a jazyk Win?
Verzia a jazyk Office?
Sub smazat_radek()
Dim Firstrow As Long
Dim Countrows As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim aDataB()
Dim rngDel As Range
Dim rngRange As Range
Const constMARK = "MW-"
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Row
Countrows = .UsedRange.Rows.Count
Set rngRange = .Cells(Firstrow, "B").Resize(Countrows)
If Countrows = 1 Then ReDim aDataB(1 To 1, 1 To 1): aDataB(1, 1) = .Cells(Firstrow, "B").Value Else aDataB = rngRange.Value
For Lrow = 1 To Countrows
If Not IsError(aDataB(Lrow, 1)) Then
If Left$(aDataB(Lrow, 1), Len(constMARK)) = constMARK Then
If rngDel Is Nothing Then Set rngDel = rngRange.Cells(Lrow) Else Set rngDel = Union(rngDel, rngRange.Cells(Lrow))
End If
End If
Next Lrow
End With
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
Beep
End Sub
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