AW: Datei zu gross und nur leere Zeilen
22.08.2006 10:15:51
Joachim
Hallo Leute, der Vorschlag hat leider nichts gebracht. Es liegt wahrscheinlich an dem Watch Sub, der auf dem Tabellenblatt liegt. Wenn ich z.B. in Zeile 200 etwas eingeben und wieder lösche, ist die letzte Zeile (Strg + Ende) die Zeile 200 usw!
Jemand eine Idee?
Joachim
******************
Private Sub Worksheet_Change(ByVal Target As Range)
Const Watch = "A:B"
Const TextNotNumeric = "not numeric!"
Const TextIsEmpty = "is empty!"
Const TextNoDate = "no date!"
Const TextDateFuture = "future date!"
Dim rng As Range, z As Range
On Error Resume Next
Set rng = Intersect(Target, Range(Watch))
If Not rng Is Nothing Then
Application.EnableEvents = False
Me.Unprotect Password:="test"
For Each z In rng
Range(Cells(z.Row, 1), Cells(z.Row, 2)).ClearComments
Range(Cells(z.Row, 1), Cells(z.Row, 2)).Interior.ColorIndex = xlNone
If Cells(z.Row, 1) = "" And Cells(z.Row, 2) = "" Then
Cells(z.Row, 3).ClearContents
Cells(z.Row, 4).ClearContents
Else
Cells(z.Row, 3) = Now
Cells(z.Row, 4) = Environ("UserName")
If Cells(z.Row, 1) <> "" Then
If Not IsNumeric(Cells(z.Row, 1)) Then
Cells(z.Row, 1).AddComment
Cells(z.Row, 1).Comment.Text Text:=TextNotNumeric
Cells(z.Row, 1).Interior.ColorIndex = 3
End If
If Cells(z.Row, 2) = "" Then
Cells(z.Row, 2) = Date
End If
End If
If Cells(z.Row, 2) <> "" Then
If Not IsDate(Cells(z.Row, 2)) Then
Cells(z.Row, 2).AddComment
Cells(z.Row, 2).Comment.Text Text:=TextNoDate
Cells(z.Row, 2).Interior.ColorIndex = 3
ElseIf Cells(z.Row, 2) > Date Then
Cells(z.Row, 2).AddComment
Cells(z.Row, 2).Comment.Text Text:=TextDateFuture
Cells(z.Row, 2).Interior.ColorIndex = 3
End If
If Cells(z.Row, 1) = "" Then
Cells(z.Row, 1).AddComment
Cells(z.Row, 1).Comment.Text Text:=TextIsEmpty
Cells(z.Row, 1).Interior.ColorIndex = 3
End If
End If
End If
Next z
Me.Protect Password:="test"
Application.EnableEvents = True
End If
End Sub