< návrat zpět
MS Excel
Téma: Funkce Match 
Zaslal/a AlesZ 24.2.2012 15:38
Dobrý den,
potřeboval bych poradit s funkcí match ve VBA.
Mám formulář, u kterého potřebuji aktivovat/deaktivovat tlačítko pro uložení podle zadaného datumu. Na listu1 je seznam rezervovaných datumů a 2 buňky pro zadání požadovaného datumu zahájení a ukončení. Funkci MATCH bych potřebovat zkontrolovat zda v seznamu je/není datum pohybující se mezi datumem zahájení a ukončení.
např. v seznamu: 1.2.12, 3.2.12, 4.2.12
požadovaný datum zahájení: 2.2.12
požadovaný datum ukončení: 5.2.12
Funkcí MATCH vyhledat, že termín 3.2. a 4.2.12 je již obsazen a vypnout tlačítko uložit.
Makro, které jsem chtěl použít:
OD - datum zahájení akce
PO - datum ukončení akce
KDE - seznam rezervovaných datumů
Dim OD As Double
Dim KDE As Range
Dim PO As Double
On Error Resume Next
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
celý cyklus se zastaví již při první proměnné i ( i = 3.2.12, resp. i = 40942 ) a nepokračuje ( chybu nenahlásí ).
budu vděčný za jakoukoli radu.
Uzamčeno - nelze přidávat nové příspěvky.
marjankaj(24.2.2012 16:04)#007422 
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
citovat
AlesZ(24.2.2012 17:25)#007425 
omlouvám se
If i >= PO Then Exit For
tahle část tam zbyla z různých pokusů a už neplatí.
aha teď jsem si všiml té chyby
celý cyklus se zastaví již na i = 2.2.12
a v případě, že zadám např. rozsah 5.2.12 - 7.2.12 tak mi toto makro taktéž vypne tlačítko, přitom by mělo zůstat zapnuté
citovat
marjankaj(24.2.2012 17:30)#007427 
A kde máš to vypínanie tlačítka?
Keď to nevidím, tak neviem povedať, čo to robí.
citovat
AleZ(24.2.2012 17:42)#007428 
Tady je celé makro
Sub vypocet1()
Dim OD As Double
Dim CO As Double
Dim KDE As Range
Dim PO As Double
OD = Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("B10").Value
Set KDE = Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("T:T")
PO = Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("B11").Value
If Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("B11").Value = "" Then GoTo testdatumu1 Else GoTo testovani1
End
testovani1:
On Error Resume Next
For i = OD To PO Step 1
CO = i
If (Application.WorksheetFunction.Match(CO, KDE, 0) > 0) = True Then GoTo vypnuti1
Next i
GoTo zapnuti1
End
testdatumu1:
On Error GoTo zapnuti1
Err.Clear
If (Application.WorksheetFunction.Match(OD, KDE, 0) > 0) = True Then GoTo vypnuti1
End
zapnuti1:
Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("C10") = "0"
Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("C10").Font.ColorIndex = 2
If Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").CommandButton1.Enabled = True Then End
Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").CommandButton1.Enabled = True
End
vypnuti1:
Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("C10") = "1"
Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").Range("C10").Font.ColorIndex = 2
If Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").CommandButton1.Enabled = False Then End
Workbooks("Predbezny pozadavek.xls").Worksheets("Žádanka").CommandButton1.Enabled = False
End
End Sub
citovat
marjankaj(24.2.2012 23:36)#007432 
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.
citovat
AlesZ(25.2.2012 16:34)#007435 
Děkuji za radu, konečně to dělá to co má

.
ve VBA nejsem nijak zběhlí a kombinaci MATCH s ON ERROR jsem již úspěšně použil, ale bez cyklu FOR.
Ještě jednou děkuji.
citovat