14.04.2016, 10:34
hallo
ich habe ein Teilprogramm auf meinen anderen Windows Rechner installiert.
Excel 2003 auf Win7 64 bit
Nun bekomme ich diesen Laufzeitfehler:
-2146232576 (80131700)
Debuggen bleibt erstmal hier stehen:
Set objAL = CreateObject("System.Collections.ArrayList")
hat jemand eine Idee ?
LG
Angelina
ich habe ein Teilprogramm auf meinen anderen Windows Rechner installiert.
Excel 2003 auf Win7 64 bit
Nun bekomme ich diesen Laufzeitfehler:
-2146232576 (80131700)
Debuggen bleibt erstmal hier stehen:
Set objAL = CreateObject("System.Collections.ArrayList")
hat jemand eine Idee ?
LG
Angelina
Code:
Option Explicit
Public Sub Kombinationen_Listen4()
Dim rngData As Range
Dim rngSpieltag As Range
Dim rngResult As Range
Dim rngReferenz As Range
Dim rngRefRow As Range
Dim dicHaeufigkeit As Object
Dim objAL As Object
Dim dicSpieltag As Object
Dim avntData() As Variant
Dim lngD1 As Long
Dim lngD2 As Long
Dim avntSpieltage() As Variant
Dim avntRowSorted() As Variant
Dim lngRS1 As Long
Dim lngRS2 As Long
Dim strKombination As String
Dim varKombination As Variant
Dim astrKombination() As String
Dim blnExist As Boolean
Dim strSpieltag As String
Set rngData = Tabelle1.Range("U24:Z58")
Set rngSpieltag = Tabelle1.Range("S24:S58")
Set rngReferenz = Tabelle1.Range("U70:Z77")
Set rngResult = Tabelle1.Range("AD1:AE1")
Set objAL = CreateObject("System.Collections.ArrayList")
Set dicHaeufigkeit = CreateObject("scripting.dictionary")
Set dicSpieltag = CreateObject("scripting.dictionary")
avntData() = rngData.Value
avntSpieltage() = rngSpieltag.Value
For lngD1 = LBound(avntData, 1) To UBound(avntData, 1)
For lngD2 = LBound(avntData, 2) To UBound(avntData, 2)
If Not IsEmpty(avntData(lngD1, lngD2)) Then
objAL.Add avntData(lngD1, lngD2)
End If
Next
objAL.Sort
avntRowSorted() = objAL.ToArray
objAL.Clear
For lngRS1 = LBound(avntRowSorted) To UBound(avntRowSorted)
For lngRS2 = lngRS1 + 1 To UBound(avntRowSorted)
strKombination = avntRowSorted(lngRS1) & ";" & avntRowSorted(lngRS2)
dicHaeufigkeit(strKombination) = dicHaeufigkeit(strKombination) + 1
strSpieltag = avntSpieltage(lngD1, 1) & WorksheetFunction.CountIf(rngSpieltag.Resize(lngD1), avntSpieltage(lngD1, 1))
If dicSpieltag.Exists(strKombination) Then
dicSpieltag(strKombination) = dicSpieltag(strKombination) & ";" & strSpieltag
Else
dicSpieltag(strKombination) = strSpieltag
End If
Next
Next
Erase avntRowSorted
Next
rngResult.EntireColumn.ClearContents
rngResult.Columns(1).Offset(, 2).EntireColumn.ClearContents
With dicHaeufigkeit
If .Count > 0 Then
For Each varKombination In .Keys
If .Item(varKombination) < 1 Then
.Remove varKombination
dicSpieltag.Remove varKombination
End If
Next
For Each varKombination In .Keys
astrKombination() = Split(CStr(varKombination), ";")
For Each rngRefRow In rngReferenz.Rows
If ExistInRefRow(rngRefRow, CLng(astrKombination(0)), CLng(astrKombination(1))) Then
blnExist = True: Exit For
End If
Next
If Not blnExist Then
.Remove varKombination
dicSpieltag.Remove varKombination
End If
blnExist = False
Next
If dicHaeufigkeit.Count > 0 Then
rngResult.Cells(1).Resize(.Count, 2).Value = _
WorksheetFunction.Transpose(Array(.Keys, .Items))
rngResult.Cells(1).Offset(, 2).Resize(dicSpieltag.Count).Value = _
WorksheetFunction.Transpose(dicSpieltag.Items)
End If
End If