Laufzeitfehler 13 - Typen unverträglich
03.02.2015 18:42:23
Heinz
Seit neuesten (eventuell nach Update) bekomme ich im unteren Code,in der Zeile
Einen Fehler:(13) "Typen unverträglich"
Könnte dazu jemand seine Hilfe anbieten?
Danke, Heinz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varTab, arrTab(), arrRange
Dim n&, nn&, strSuchWert$
Dim oDic As Object
Application.ScreenUpdating = False
Sheets("Üst").Unprotect Password:="vetro"
If Intersect(Range("A2"), Target) Is Nothing Then Exit Sub
arrTab = Array("Jänner", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", " _
September", "Oktober", "November", "Dezember")
Set oDic = CreateObject("Scripting.Dictionary")
strSuchWert = Range("A2")
If strSuchWert "" Then
For Each varTab In arrTab
With Sheets(varTab)
arrRange = .Range("A3", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, .Cells(1, . _
Columns.Count).End(xlToLeft).Column)
End With
For n = 1 To UBound(arrRange)
For nn = 3 To UBound(arrRange, 2)
If InStr(arrRange(n, nn), strSuchWert) > 0 Then
oDic(arrRange(n, 1)) = oDic(arrRange(n, 1)) + 8
End If
Next nn
Next n
Next varTab
End If
With ActiveSheet
Application.EnableEvents = False
.Range("A3", .Cells(.Rows.Count, 2)).ClearContents
If oDic.Count > 0 Then
.Cells(3, 1).Resize(oDic.Count) = Application.Transpose(oDic.keys)
.Cells(3, 2).Resize(oDic.Count) = Application.Transpose(oDic.items)
End If
Application.EnableEvents = True
End With
Range("A3:B154").Sort Key1:=Range("B3"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Üst").Protect Password:="vetro"
Application.ScreenUpdating = True
End Sub