VBA Code funktioniert nicht
18.07.2023 15:05:20
Jo
habe mir diesen Code erfragt und auch selbst versucht aber es passiert nichts alles bleibt leer
Sub DatumEintragen()
Dim blutzuckerSheet As Worksheet
Dim tagebuchSheet As Worksheet
Dim blutzuckerRange As Range
Dim tagebuchRange As Range
Dim eintragDatum As Variant
Dim letzteZeile As Long
Dim ausgabeBereich As Range
Dim i As Long
' Setze die entsprechenden Arbeitsblätter
Set blutzuckerSheet = ThisWorkbook.Sheets("Blutzucker")
Set tagebuchSheet = ThisWorkbook.Sheets("Tagebuch")
' Setze die entsprechenden Zellbereiche
Set blutzuckerRange = blutzuckerSheet.Range("B9")
Set tagebuchRange = tagebuchSheet.Range("c1") ' Ändere den Bereich entsprechend deiner Daten
' Setze den Ausgabe-Bereich in Blutzucker!A11:A300
Set ausgabeBereich = blutzuckerSheet.Range("A11:A300")
' Leere den Ausgabe-Bereich
ausgabeBereich.ClearContents
' Finde das Datum in "Tagebuch" und trage es in "Blutzucker" ein
letzteZeile = tagebuchSheet.Cells(tagebuchSheet.Rows.Count, 1).End(xlUp).Row
' Überprüfe, ob eine Übereinstimmung gefunden wird
For i = 2 To letzteZeile
If blutzuckerRange.Value = tagebuchSheet.Range("C" & i).Value And tagebuchSheet.Range("C" & i).Value > 0 Then
eintragDatum = tagebuchSheet.Range("A" & i).Value
If IsDate(eintragDatum) Then
ausgabeBereich.Cells(1).Value = eintragDatum
ausgabeBereich.Cells(2).Value = "Tageszeit"
ausgabeBereich.Cells(3).Value = "Meßzeit"
Exit For ' Beende die Schleife nach dem ersten Datum
End If
End If
Next i
' Lösche leere Zeilen im Ausgabe-Bereich
For i = ausgabeBereich.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(ausgabeBereich.Rows(i)) = 0 Then
ausgabeBereich.Rows(i).Delete Shift:=xlUp
End If
Next i
End Sub
weiß jemand Rat.
Bin für jede hilfe Dankbar
Gruß Jo