VBA in Excel: Warum funktioniert das Auslesen der Daten nicht?

Question

Guten Tag,

ich möchte gerne das eingetrage Datum in Spalte I mit dem Datum von heute vergleichen.

Wenn das eingetragene Datum in der Vergangenheit liegt, soll die Zellenhintergrundfarbe in Spalte A rot werden, ansonsten grün.

Momentan bekomme ich nur FLASCH ausgelesen.

Bisher habe ich die Shcleife bis 50 festgelegt am liebsten möchte ich die Schleife bei der letzten geschrieben Zelle von Spalte I enden lassen.

Könnt ihr mir weiterhelfen?

Vielen Dank schon einmal!

Anbei der Code:

'#######################################################

Option Explicit

Dim i As Integer

Sub Dateien_auswerten()


For i = 4 To 50
If ThisWorkbook.Sheets(1).Cells(i, 6) <> "" And ThisWorkbook.Sheets(1).Cells(i, 6) <= Date + 1 Then

ThisWorkbook.Sheets(1).Cells(i, 1) = ThisWorkbook.Sheets(1).Cells(i, 1).Interior.ColorIndex = 4 'grün
Else
ThisWorkbook.Sheets(1).Cells(i, 1) = ThisWorkbook.Sheets(1).Cells(i, 1).Interior.ColorIndex = 3 '3 rot


End If


Next i

End Sub
'######################################################

Viele Grüße
Philip

Answer 1

Hallo Philip,

da du mit

ThisWorkbook.Sheets(1).Cells(i, 1) = ThisWorkbook.Sheets(1).Cells(i, 1).Interior.ColorIndex = 4 'grün

einen Vergleich machst, der nicht wahr ist, wird in Spalte A falsch geschrieben.

Wenn du die Zelle füllen willst, dann so:

ThisWorkbook.Sheets(1).Cells(i, 1).Interior.ColorIndex = 4 'grün

Versuch mal den folgenden Code:

Option Explicit

Sub Dateien_auswerten2()
Dim i As Integer

With ThisWorkbook.Worksheets(1)

For i = 4 To .Cells(Rows.Count, 6).End(xlUp).Row
If .Cells(i, 6) <> "" Then
If .Cells(i, 6) <= Date + 1 Then
.Cells(i, 1).Interior.ColorIndex = 4 'grün
Else
.Cells(i, 1).Interior.ColorIndex = 3 '3 rot
End If
End If
Next i

End With

End Sub

Du kannst das aber auch ohne VBA mit der bedingten Formatierung machen.

Gruß

M.O.

Answer 2

Hallo,

nochmal ich ;-). Du schreibst:

Wenn das eingetragene Datum in der Vergangenheit liegt, soll die Zellenhintergrundfarbe in Spalte A rot werden, ansonsten grün.

Dann musst du die Farben wechseln:

Option Explicit

Sub Dateien_auswerten2()
Dim i As Integer

With ThisWorkbook.Worksheets(1)

For i = 4 To .Cells(Rows.Count, 6).End(xlUp).Row
If .Cells(i, 6) <> "" Then
If .Cells(i, 6) <= Date + 1 Then
.Cells(i, 1).Interior.ColorIndex = 3 'rot
Else
.Cells(i, 1).Interior.ColorIndex = 4 'grün
End If
End If
Next i

End With

End Sub

Mit deiner Prüfung wird auch der jeweils auf das aktuelle Datum folgende nächste Tag rot angezeigt.

Gruß

M.O.

Answer 3

Hallo mo,

Vielen Dank für die schnelle und gute Hilfe.

Ich habe nun noch ein Zähler reingestellt, der bei jeder neuen beschrieben Zeile eine neue Item Nummer in Spalte B generieren soll.

Der Zähler soll ab Zeile 4 beginnen und sich um 1 erhöhen.

For k = 1 To .Cells(Rows.Count, 2).End(xlUp).Row
Cells(k + 3, 2).Value = k
Next k

Jedoch endet der Zähler nicht in der letzten beschrieben Zeile, sondern viel später.


VG
Philip

Answer 4

Hallo Philip,

ich kenne deine Tabelle nicht. Aber was mir auffällt, ist, das du in Spalte B eine Nummer reinschreiben willst und dazu die letzte beschrieben Zeile in Spalte B ermittlen willst.
Ich würde entweder die letzte beschriebene Zeile in Spalte F ermittlen (falls das Datum immer vorhanden sein muss) bzw. in einer anderen Spalte, die unbedingt ausgefüllt sein muss (Spalte A?).

Gruß

M.O.

Answer 5

Hallo Mo,

genau, ich möchte ab der Zeile 4 in Spalte B den Zähler bei 1 beginnen, da ab der Zeile den Input erst beginnt. Zeile 1 bis 2 sind Überschriften.

Der Zähler soll bis zur letzten beschriebenen Zeile gehen.

In meiner Tabelle wir in der Spalte A der Status mit rot und grün gezeigt, den wir ja schon gelöst haben. :)
IN spalte B soll die Nummer der Items kommen.
IN Spalte C bis M kommen die Inputs für das neue Item.

Sobald ein neuer Eintrag (Spalte C:M) in einer neuen Zeile vorliegt, soll automatisch die Item Nr. generiert werden.

Hoffe, das Problem ist nun klarer geworden.

VG
Philip

Answer 6

Hallo Philip,

da du die Nummer ja automatisch bei der Eingabe generieren willst, muss das folgende Makro in das VBA-Projekt der entsprechenden Tabelle:

Private Sub Worksheet_Change(ByVal Target As Range)
'Makro nur ausführen, wenn Eingabe in den Spalten C bis M erfolgt
If Not Intersect(Target, Range("C:M")) Is Nothing Then
If Target.Row > 3 Then 'aber erst ab Zeile 4
'prüfen, ob tatsächlich eine Eingabe erfolgt ist und ob Spalte B der betreffenden Zelle leer ist und falls ja, dann neue Nummer einfügen
'die neue Nummer wird mit der Funktion MAX generiert: höchste Zahl im beschriebenen Bereich der Spalte B +1
If IsEmpty(Target) = False And IsEmpty(Cells(Target.Row, 2)) = True Then Cells(Target.Row, 2) = Application.WorksheetFunction.Max(Range("B4:B" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)) + 1
End If
End If

End Sub

Gruß

M.O.

Answer 7

Hallo M.O.,

vielen Dank für den perfekten Support, genau die Lösung habe ich gebraucht. :)

Frohe Ostern.

VG
Philip