MS Excel

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.citovat