Sub Vyhledat_a_Zapsat_Datum()
    Dim Datum As Date
    Dim C As Range
    Dim DatumZapsane As Boolean
    
    ' Zeptáme se uživatele na datum
    Datum = InputBox("Zadejte datum (ve formátu DD.MM.RRRR):")
    DatumZapsane = False
    
    ' Projdeme každou buňku v listu aktivního sešitu
    For Each C In ActiveSheet.UsedRange
        ' Pokud buňka obsahuje hledaný text "kCal"
        If InStr(1, C.Value, "kCal", vbTextCompare) > 0 Then
            ' Zapišeme datum do buňky o řádek výše a sloupec doleva
            If DatumZapsane = False Then
                C.Offset(-1, -1).Value = Datum
                DatumZapsane = True
            Else
                Datum = Datum + 1
                C.Offset(-1, -1).Value = Datum
            End If
        End If
    Next C
End Sub