ich habe ein Problem mit einem bestehenden VBA-Code.
Im März hatte ich einen Thread mit dem u.g. Code und der anhängenden Beispieldatei eröffnet. In der Beispieldatei klappt der Code gut, in einer anderen Datei kommt allerdings eine Fehlermeldung "Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert"!?
Ausgelöst wird die Meldung durch die Code-Zeile "Dim xDic As New Dictionary".
Habt ihr eine Idee warum der Code in der einen Datei klappt und in der anderen nicht (gleicher Rechner, gleiche Softwareversionen...)?
https://www.herber.de/bbs/user/146629.xlsm
Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Previous value :"
x = xDic.Keys
For I = 0 To UBound(xDic.Keys)
Set xCell = Range(xDic.Keys(I))
Set xDCell = Cells(xCell.Row, Target.Column + 1)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
On Error GoTo Label1
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Set xDependRg = Target.Dependents
If xDependRg Is Nothing Then GoTo Label1
If Not xDependRg Is Nothing Then
Set xDependRg = Intersect(xDependRg, Range("B:B,E:E,H:H"))
End If
Label1:
Set xRg = Intersect(Target, Range("B:B,E:E,H:H"))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
Set xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Set xRgArea = xChangeRg.Areas(I)
For J = 1 To xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End Sub
Danke schon einmal im VorausGruß
Dirk