• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Ja som z tých podmienok trochu pomotaný, ale skúste toto. Uvádzam len ako príklad na to aby som ja pochopil logiku :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

For i = 1 To 10
If InStr(Cells(i, 2).Value, "2018") > 0 Then
Cells(i, 3).Value = "OK"
Else
If InStr(Cells(i, 4), "cvt") > 0 Then
Cells(i, 2) = Cells(i, 2) & "/2018"
Cells(i, 3).Value = "OK"
Else
Cells(i, 3).Value = ""
End If
End If
Next i
End Sub
Každopádne, o koľko ide reálne dát ? Je nevhodné to robiť bunku po bunke na väčšom množstve dát - bude to pomalé. Navyše po každom označení bunky? To by bolo lepšie po každej zmene bunky, nie po označení, s tým že by sa na začiatok a koniec vypli/zapli Application.EnableEvents=False (True).
Ten cyklus má mať vždy 10 riadkov ?
OK sa má napísať vždy keď B obsahuje 2018, bez ohľadu na to či je v D hodnota "cvt" alebo nie ?

Šmarjá zase popis bez prílohy, a zase nejednoznačne pochopiteľný. Bez prílohy výstrel na slepo :
COUNTIF
SUMIF
MATCH / POZVYHLEDAT
VLOOKUP / SVYHLEDAT

Neviem ako presne kooperuje aplikačná vrstva kompilátoru VBA s OS a CPU, ale ak je tam skutočne nejaký tzv. špekulatívny výpočet (prediktívny), tak je slušná šanca, že to urobí aj za zobrazením Formulára, aj keď sa o tom nedozviete, ani keď si dáte Breakpoint. Treba vyskúšať, a ak to bude OK tak to bude asi kratšia cesta ako hľadať ťažko dostupné riešenie nepravidelného a ťažko odchytiteľného problému.

A kde v tomto vzorci niečo hľadáte ?
=VLOOKUP(B2;#ODKAZ!;4;FALSE)
=SVYHLEDAT(B2;#ODKAZ!;4;NEPRAVDA)
Ja keď si urobím pokusne nejakú zdrojovú tabuľku z Vašich dát, čo tam máte, tak mi to hľadá aj s "-" aj bez. Proste mi to nájde. Dajte reálnu prílohu bez odstránenej tabuľky na prehľadávanie, vzorkou reálnych (obdobných) dát, a v nepoškodenej prílohe.

Tento môj kód je na tú Vašu prvotnú prílohu (teraz je ešte v príspevku od Jiří497(18.2.2018 22:30) :
Private Sub Workbook_Open()
Dim Oblast As Range
Set Oblast = Range(Cells(1, 2), Cells(1, Columns.Count).End(xlToLeft))
On Error Resume Next
If Oblast.Offset(1, 0).Cells(1, WorksheetFunction.Match(CDbl(Date), Oblast, 0)).Value2 = 1 Then MsgBox "Pod dnešným dátumom je hodnota 1.", vbExclamation, "Upozornenie"
On Error GoTo 0
Set Oblast = Nothing
End Sub

Tento môj kód :
On Error Resume Next
x = WorksheetFunction.Match(CDbl(Date), Range("A1:AC1"), 0)
If Err > 0 Then MsgBox "Upoxornenie", vbExclamatoin
On Error GoTo 0
je reakcia na kód od Jiří497(20.2.2018 12:12) :
Sub pokus()
x = WorksheetFunction.Match(Date, Range("A1:AC1"), 0)
End Sub

No a takýto nejaký kód potrebujete na ten svoj posledný súbor (ktorý ste v prvom príspevku vymenila, nie ?):
Private Sub Workbook_Open()
Dim Riadkov As Long, arrStlpec()

With Worksheets("MK")
Riadkov = .Cells(Rows.Count, 2).End(xlUp).Row
ReDim arrStlpec(1 To Riadkov, 1 To 1)
If Riadkov = 1 Then arrStlpec(1, 1) = .Cells(1, 2).Value2 Else arrStlpec = .Cells(1, 2).Resize(Riadkov).Value2

On Error Resume Next
For i = 0 To Riadkov Step 7
If Month(arrStlpec(i + 1, 1)) = Month(Date) And Year(arrStlpec(i + 1, 1)) = Year(Date) Then
If .Cells(i + 2, 6 + WorksheetFunction.Match(CDbl(Date), .Range("G1:AH1").Offset(i, 0), 0)).Value2 = 1 Then MsgBox "Pod dnešným dátumom je hodnota 1.", vbExclamation, "Upozornenie"
Exit For
End If
Next i
On Error GoTo 0
End With
End Sub

Všetky som robil a skúšal v nejakom kontexte.

PS: Ešte poznámka k prehľadávanej oblasti v Match. Na ukážku v prvých kódoch sa ráta iba s jediným listom. V reále treba určiť list, tak ako som to urobil v poslednom kóde. Môže totiž nastať napr. to, že nebude list pri otváraní aktívny.

-Niekde bokom si napíšte do nejakej bunky číslo 1.
-Označte ju, a dajte Ctrl+C.
-Označte všetky dátumy, ktoré sú ako Text.
-Pravý klik na označené - Možnosti prilepenia - Prilepiť špeciálne - Prilepiť špeciálne - Násobenie - OK
-Pravý klik na označené - Formátovať bunky - Dátum - OK.
-Vymažte to číslo 1.

Áno. Cdbl(), ale určite použite aj On Error, lebo ak tam ten dátum nebude, makro padá na chybe. Preto je tam ten On Error. Ak v následnom teste je Err iné ako 0, tak nastala chyba, a dátum tam nieje. Ak je Err=0 tak už robte čo potrebujete s nájdenou pozíciou X.

On Error Resume Next
x = WorksheetFunction.Match(CDbl(Date), Range("A1:AC1"), 0)
If Err>0 then MsgBox "Upoxornenie", vbExclamatoin
On Error Goto 0

marjankaj : To MAX() je super nápad, odbúra sa jeden výpočet NETWORKDAYS.INTL. Ale aj tak musí byť pre každý riadok kompletná sada sviatkov. Prípadne ak nie v pomocných stĺpcoch, tak potom vytvoriť nejakú maticu, ale takto je to asi servisovateľnejšie.

EDIT: Aby som len netrepal, tak ma napadlo jedno megavzorcové maticové riešenie, viď príloha, bez pomocných stĺpcov. Musí byť ale minimálne jeden Definovaný názov, lebo zlúčené bunky nezoberú inak maticový vzorec. Ale aj tak som to rozdelil na 3 Definované názvy, lebo keď sa to spojí do jedného hypermegagigavzorca, tak bude mať asi meter, a nikto ho už nikdy nepochopí :). Sranda aké hovadiny sa dajú robiť v Exceli. Ale toto by som asi radšej nepoužíval, ako vravím, servisovateľnosť od človeka, čo to netvoril je chabá...

Pr.
EDIT: Pardom zabudol som "zabudovať" sviatky pre každý riadok ... príloha vymenená.

Zaznamenal som rovnaký problém. Ale možno by bolo dobré sem priložiť celé zošity (bez citlivých dát).

Private Sub Workbook_Open()
Dim Oblast As Range
Set Oblast = Range(Cells(1, 2), Cells(1, Columns.Count).End(xlToLeft))
On Error Resume Next
If Oblast.Offset(1, 0).Cells(1, WorksheetFunction.Match(CDbl(Date), Oblast, 0)).Value2 = 1 Then MsgBox "Pod dnešným dátumom je hodnota 1.", vbExclamation, "Upozornenie"
On Error GoTo 0
Set Oblast = Nothing
End Sub

Criteria1:="<>" - zobrazí všetky riadky, ktoré majú v danom stĺpci nejakú hodnotu
Criteria1:="" - zobrazí všetky riadky, ktoré nemajú v danom stĺpci žiadnu hodnotu

To "Criteria1:=XYZ" znamená, že XYZ je to, čo chcete mať zobrazené, nie to čo chcete mať skryté. Teda vo Vašom prípade použite
ActiveSheet.Range("$A$8:$AS$150").AutoFilter Field:=38, Criteria1:=""

Vy chcete nájsť riadok s hodnotou v stĺpci A, bez ohľadu na to, či je riadok skrytý alebo nie ?
Tak skúste MATCH
Dim r As Long
On Error Resume Next
r = WorksheetFunction.Match(10, Columns(1), 0)
If Err.Number <> 0 Then r = 0
On Error GoTo 0
a máte riadok. Namiesto toho "r = 0" si dajte vhodnú akciu pre prípad, že položku nenájde.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse