Sortierfunktion verursacht Fehler
Mike
ich verwende unten stehenden Code um Änderungen in einem Tabellenblatt zu protokollieren.
Werden dort in den ersten 1000 Zeilen Daten geändert, wird beim Speichern der Datei ein Log-File als Textdatei erstellt.
Das klappt soweit sehr gut.
Mein Problem, dass offenbar das Verwenden der Sortierfunktion diesen Code durcheinander bringt, da jedes Mal, wenn ich die Daten sortiere der Debugger anspringt und einen Run Time Error anzeigt.
Fehlermeldung: Run Time Error 13, Type Mismatch.
Angezeigte Zeile im Debug-Modus: mstrOld(rng.Row, rng.Column) = rng.Value (ganz am Ende des Codes).
Wisst Ihr irgendeinen Trick, wie man das vermeiden kann ?
Verwendeter Code:
Option Explicit
Dim mstrOld(1 To 1000, 1 To 16384) As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1000 Then Exit Sub
Dim strDatei As String, strText As String
Dim intFile As Integer, rng As Range
Const strDELIM As String = " | "
intFile = FreeFile
With ThisWorkbook
strDatei = "C:\Users\Notebook\Desktop\My Documents\LogFiles\LogFile_" & Replace(.Name, " _
.xlsm", "") & ".txt"
End With
Open strDatei For Append As #intFile
If LOF(intFile) = 0 Then
strText = "Date & Time | User | Cell | Old Value | New Value"
Print #intFile, strText
End If
For Each rng In Target.Cells
If rng.Value mstrOld(rng.Row, rng.Column) Then
strText = _
Format(Now, "YYYY/MM/DD hh:mm") & strDELIM & _
Environ("username") & strDELIM & _
rng.Address & strDELIM & _
mstrOld(rng.Row, rng.Column) & strDELIM & _
IIf(Len(rng), rng.Value, "---") & strDELIM
Print #intFile, strText
End If
Next
Close #intFile
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row > 1000 Then Exit Sub
Dim rng As Range
For Each rng In Target.Cells
mstrOld(rng.Row, rng.Column) = rng.Value
Next
End Sub
Mike