Příspěvky uživatele
< návrat zpět
Sub vypocet1()
Dim OD As Double
Dim CO As Double
Dim KDE As Range
Dim PO As Double
Dim sh As Worksheet
Dim bunka As Range
Set sh = Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka")
'Set sh = Worksheets("hárok1")
OD = sh.Range("B10").Value
Set KDE = sh.Range("T:T")
PO = sh.Range("B11").Value
If sh.Range("B11").Value = "" Then PO = OD
For i = OD To PO Step 1
CO = i
For Each bunka In KDE
If bunka = CO Then
sh.Range("C10") = 0
sh.Range("C10").Font.ColorIndex = 2
sh.CommandButton1.Enabled = True
Exit Sub
End If
Next bunka
Next i
sh.Range("C10") = 1
sh.Range("C10").Font.ColorIndex = 2
sh.CommandButton1.Enabled = False
End Sub
Tá kombinácia MATCH s ON ERROR asi nebude najvhodnejšia.
A kde máš to vypínanie tlačítka?
Keď to nevidím, tak neviem povedať, čo to robí.
To Jeza:
Ale ak tam budú aj dátumy s bodkami, tak budú zase tie dátumy pošahané.
i=3.2.12 je druhá premenná v poradí. A v cykle je splnená podmienka, teda vyskočí z cyklu.
For i = OD To PO Step 1
If (Application.WorksheetFunction.Match(i, KDE, 0) > 0) = True Then GoTo vypnuti1
If i >= PO Then Exit For
Next i
To zvýraznené je tam načo? 
i=2.2.12 nie je v zozname
i=3.2.12 je v zozname a vyskočí z cyklu
na i=4.2.12 sa už nedostane
ani na i=5.2.12
Presne tak ako píše AL.
K možnosti d) iba poznámka
Netreba v ovládacích paneloch.
Stačí v exceli(2007 a vyššie. V 2003 je to obdobné) v možnostiach -> rozšírené dať ako oddeľovač desatinných miest "."
To je pre vkladanie cez CTRL+C a CTRL+V.
A potom samozrejme vrátiť naspäť ",".
Skús funkciu automatický filter. Možno bude vyhovovať.
No vlastne si to vymyslel ty. Mne iba vŕtalo, prečo by to nešlo vylepšiť. :)
Tak som niečo poskúšal. Na konci stačí prázdny ENTER
Option Explicit
Dim Isect As Range
Dim x As String
Dim Nad As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Isect = Application.Intersect(Range("C2:C500"), Range(ActiveCell.Address))
If Not Isect Is Nothing Then
Set Nad = Isect.Offset(-1, 0)
If Nad <> "" And Isect = "" Then
Isect = "'" & Right(Nad, Len(Nad) - InStr(Nad, "-") - 1) & " - "
x = InputBox(Isect)
Isect = Isect & x
If x = "" Then
ActiveCell.Offset(0, 0).Clear
Else
ActiveCell.Offset(1, 0).Select
End If
End If
End If
End Sub
A čo tak vložiť tam INPUTBOX? Nie je to veľmi praktické, ale na tento účel snáď použiteľné.
Option Explicit
Dim Isect As Range
Dim Nad As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Isect = Application.Intersect(Range("C2:C500"), Range(ActiveCell.Address))
If Not Isect Is Nothing Then
Set Nad = Isect.Offset(-1, 0)
If Nad <> "" And Isect = "" Then
Isect = "' " & WorksheetFunction.Text(Right(Nad, Len(Nad) - InStr(Nad, "-") - 1), "h:mm") & " - "
Isect = Isect & InputBox(Isect)
End If
End If
End Sub
No niečo sa mi podarilo aj bez makra.
Treba si označiť poslednú bunku v stlpci A
Je to pomenovaná bunka "posledná" a je to vlastne číslo posledného riadku.
No neviem, či sa tam tá hodnota bude vyskytovať viackrát. Ak áno potom je najlepšie urobiť to makrom.
A možno by si mohol vyskúšať automatický filter. Dáš si zobraziť potrebnú hodnotu a potom to ručne skopíruješ, kam budeš chcieť. Tých 10 listov si môžeš spojiť do jedného listu, alebo si to 10 krát zopakuješ.
Skús priložiť nejakú ukážku.
V stlpci E je zoznam priezvisk. V stlpci F sa ti ukáže, či sa nachádza v stlpci A.
V bunke E1 si vyber priezvisko, ktoré chceš zobraziť a v stlpci B sa ti zobrazí. Automatickým filtrom si to môžeš vyfiltrovať.
Nie je to dokonalé. Hľadá to aj priezviská neoddelené nijakým znakom.
Pri hodnote=-1 musia byť prvky zoradené zostupne.
Možno by stačilo aj toto
=(A1>0)*(B1<0)
A ak by to chcel ako v predchádzajúcom príspevku, tak
=CHOOSE(((A1>0)*SIGN(-B1))+2;0;"";1)
Povolenie makier je na zošite nezávislé. Inak by ochrana asi nemala zmysel. "Vypnutie" makier je možné pri otvorení zošitu s makrami, podržaním klávesu "SHIFT".
To by asi museli "prekopať" excel.
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