|
Kann mir jemand weiterhelfen wieso die VBA den wert troz der Prüfung des wertes ob er vorhanden ist diesen troztem in die Zweite Tabelle "TagListe" schreibt und die routine nicht beendet?
Private Sub CommandButton1_Click()
Dim lloRow As Long, lboExist As Boolean, lloLast As Long
If Range("G8").Value <> "" Then
With Sheets("TagListe")
lloLast = .Cells(Rows.Count, 1).End(xlUp).Row
For lloRow = 2 To lloLast
If LCase(Range("G8").Value) = LCase(.Range("B" & lloRow).Value) Then _
MsgBox "Diesen Eintrag gibt es schon.", vbExclamation, "Hinweis"
lboExist = True
Next
Application.EnableEvents = True 'Neu Reingeschrieben
Dim PNr As Integer
Dim SourceSheet As Worksheet
Dim TestStr As String
Startzeile = 2 ' erste Datenzeile
ActiveSheet.Unprotect
ActiveSheet.Unprotect
SourceCount = Startzeile
PNr = 1
Set SourceSheet = Application.Sheets("TagListe") ' suche in TagListe
While SourceSheet.Cells(SourceCount, 1).Value <> ""
If SourceSheet.Cells(SourceCount, 1).Value > PNr Then
PNr = SourceSheet.Cells(SourceCount, 1).Value
End If
SourceCount = SourceCount + 1
Wend
SourceCount = Startzeile
Tag = ThisWorkbook.Worksheets("TPTagNr").Range("G8").Value
Set SourceSheet = Application.Sheets("TagListe")
While SourceSheet.Cells(SourceCount, 1).Value <> ""
If SourceSheet.Cells(SourceCount, 1).Value > Tag Then
Tag = SourceSheet.Cells(SourceCount, 1).Value
End If
SourceCount = SourceCount + 1
Wend
SourceSheet.Cells(SourceCount, 1).Value = PNr + 1 ' neue Nummer eintragen
SourceSheet.Cells(SourceCount, 2).Value = Tag ' TagNummer eintragen eintragen
SourceSheet.Cells(SourceCount, 3).Value = Date + Time
End With
End If
End Sub
|