Ja som to tiež skúšal spracovať v jednom vzorci, cez SUBSTITUTE/DOSADIT v matici, no to sa mi nepodarilo. Ono totiž ten vzorček dáva pole už upravených znakov, a napadlo ma ho indexovať v SUBSTITUTE v matici a nahradiť nimi pôvodné, žiaľ neúspešne.
Riešenie je to zaujímavé.
No obaľte ten vzorec do IFERROR()
=IFERROR(VLOOKUP(Tabuľka2[@Tovar];Tabuľka2;2;FALSE);"")
=IFERROR(SVYHLEDAT(Tabuľka2[@Tovar];Tabuľka2;2;NEPRAVDA);"")
Napr.
Ešte by stálo za to poukázať na možný problém s EnableEvents. Ak totiž volané makro skončí chybou, debuguje, užívateľ to následne Stopne, lebo si nebude vedieť rady, tak udalosti ostanú vypnuté. V tomto prípade je pravdepodobnosť dosť malá, že pri kopírovaní nastane chyba, ale ak by sa jednalo o zložitejšie makro, tak by som odporúčal procedúry zmeniť na funkcie, obaliť ich On Error kontrolou, a riadiacej procedúre poslať info o prípadnej chybe. Aby užívateľ vedel o chybe (to by zistil aj bez toho), ale aby EnableEvents ostalo zapnuté.
Teda napr.:
Function Makro1() As Boolean
'
'Nepřestupný
On Error GoTo KONIEC
Range("BB45:BE61").Copy Destination:=Range("AF45:AI45")
Exit Function
KONIEC:
Makro1 = True
End Function
Function Makro2() As Boolean
'
' Přestupný
On Error GoTo KONIEC
Range("AU45:AX61").Copy Destination:=Range("AF45:AI45")
Exit Function
KONIEC:
Makro2 = True
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Chyba As Boolean
If Not Intersect(Target, Cells(2, 3)) Is Nothing Then
Application.EnableEvents = False
If Cells(2, 3) Mod 4 = 0 Then Chyba = Makro2 Else Chyba = Makro1
If Chyba Then MsgBox ("Nastala chyba.")
Application.EnableEvents = True
End If
End Sub
Zmenil som Vám tam kopírovanie na oveľa jednoduchšie, ak už ten február/únor chcete riešiť takto.
Myslíte toto ? - vložiť kód do listu "List2 (Plán)"
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Cells(2, 3)) Is Nothing Then
Application.EnableEvents = False
If Cells(2, 3) Mod 4 = 0 Then Call Makro2 Else Call Makro1
Application.EnableEvents = True
End If
End Sub
Takto by to mohlo fungovať:
Private Sub tbNumber_GotFocus()
tbNumber.Text = Replace(tbNumber.Text, Chr(160), vknullstring) 'Odstránenie formátovaných medzier
'''tbNumber.Text = Cells(3, 2) 'Voľba pre uchovanie neupravenej hodnoty v bunke, predošlý riadok zrušiť
End Sub
Private Sub tbNumber_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Shift Then KeyCode = 0 'Ctrl, Shift, Alt
Select Case KeyCode
'8 BackSpace
'37 a 39 šípka vľavo a vpravo
'46 Delete
'48..57 0 až 9
'96..105 numerické čísla
'109 a 191 num "-" a "-"
'110 a 188 num "," a ","
Case 8, 37, 39, 46, 48 To 57, 96 To 105
Case 109, 110, 188, 191: If Not IsNumeric(tbNumber.Text) Then KeyCode = 0
Case 13: tbNumber.TopLeftCell.Offset(1, 0).Activate
Case Else: KeyCode = 0
End Select
'''Cells(3, 3) = tbNumber.Text 'Voľba pre uchovanie neupravenej hodnoty v bunke
End Sub
Private Sub tbNumber_LostFocus()
tbNumber.Text = Format(tbNumber.Text, "#.##0") 'Naformátovanie
End Sub
To prvé bol iba ujo guugl z tabletu od kávy. Ale tento kód mne funguje, ale načo je to dobré ???
Iba z tabletu, inšpirujte sa z tohoto kódu zo stackoverflow
Public Sub UserForm_Initialize()
TextBox6.Text = Format(Number, "0.0000")
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox6.Value) Then
TextBox6.Text = Format(TextBox6, "0.0000")
End If
End Sub
Private Sub TextBox6_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'// Disregard keys other than 0-9/period/minus sign.
If Shift Then KeyCode = 0
Select Case KeyCode
Case 8, 13, 46, 48 To 57, 96 To 105, 109, 110, 189, 190
Case Else
KeyCode = 0
End Select
End Sub
Je z formulára, ale to snáď jasné.
V podobnej téme som radil toto
EDIT:
Tu máte príklad. Otázkou je, či tá Vaša aktualizácia vyvolá metódu Change, resp. neviem ako to budete aktualizovať, či nejakým SQL dopytom, či časovaným makrom, ...
Zabudnutá téma ?
Pre ListBox na liste
...
Dim s As String, i As Integer
With Worksheets("List2").ListBoxes("lbVyber") 'Je vhodné si LB premenovať
For i = 1 To UBound(.List)
If .Selected(i) Then s = s & IIf(s = "", "", ", ") & .List(i)
Next i
End With
.TextBody = s
...
Pre ListBox na UserForm-e
...
Dim s As String, i As Integer
With UserForm1.lbVyberForm
For i = 0 To .ListCount - 1
If .Selected(i) Then s = s & IIf(s = "", "", ", ") & .List(i)
Next i
End With
.TextBody = s
...
CheckBox nevyvoláva Worksheet_Change. Treba použiť fintu, skopírovania prepojenej bunky do inej bunky, a to vyvolá Calculate metódu. Viz príloha.
Iným riešeným by bolo použitie CheckBoxu ActiveX, ktorý ma OnClick metódu.
Presne tak:
Function ftbCheck(name As String) As Boolean
Dim Exist As Boolean
On Error Resume Next
Exist = Not ThisWorkbook.Worksheets("Hárok1").OLEObjects.Item(name) Is Nothing
ftbCheck = Exist
End Function
Sub test()
MsgBox ftbCheck("TextBox2")
End Sub
Ja nechcem rýpať páni, môžete ma ešte nasmerovať ako odstrániť označené ? Obe Vaše verzie mi zaokrúhľujú to posledné číslo...
Aké obe verzie?
Podmienený formát predsa nič nezaokrúhľuje iba zobrazuje.
A ak chceš zobraziť číslo 123456 na tri platné, tak vedeckým formátom 0,00 E+00(čo je univerzálne a mohlo by vyhovovať)
A to zaokrúhľovanie je predsa logické, to formát čísla predsa robí bežne.
Ja nechcem rýpať páni, môžete ma ešte nasmerovať ako odstrániť označené ? Obe Vaše verzie mi zaokrúhľujú to posledné číslo, a k tomu neviem formátom odstrániť celé čísla (teda ak je viac ako 3 nedesatinné miesta). Vlastne ani tým lubovím vzorcom. Nie som taký skúsený, ale na margo mi nedá sa nespýtať: INT vracia najbližšie menšie číslo - teda odreže desatiny pri kladnom, ale záporné "pokazí", ak to chápem dobre. Nebude tu ten problém so zaukrúhlením ? Ďalej keď zmením na 2 čísla, tak ten vzorec už zaokrúhli všetko na 0,13 ... 1,3 a pod.
Keď aj pominieme možnosť zmeny počtu čísel (to nebolo požadované), prosím o pomoc s pochopením, ako doriešiť to ostatné.
@ lubo: nič, samozrejme to nieje problém. Ale keďže sa do tabuľky sviatkov len tak nezasahuje, tak je zbytočný ďalší list, alebo tabuľka.
@ marjankaj: samozrejme, veď ten vzorec na výpočet veľkej noci v tom mojom podmienenom formátovaní mám.
@ Opičák: viď 2. veta pre "lubo" - nezavadzia tabuľka.
Neviem či som urobil ten Váš formát správne, pls junknite. Ak áno, tak takto to asi nemyslel. Formátom by som to nevedel, ale vzorcom by sa to dalo riešiť napr. takto.
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.