---

Hallo,

ich peile es gerade nicht... Ich möchte aus einem Array die doppelten Einträge filtern und in ein neues Array übergeben.

Vorhanden: Ein Array als Variant -> varDaten
Ziel: varDatenDoppelt

Ich habe schon einige Beispiele im Internet gefunden, kann diese aber nicht zum laufen bringen. Hat jemand ein "fertiges" Beispiel für mich was im Inventor funktioniert?!

Meine Code-Beispiele:
http://www.j-hennekes.de/1066678.htm
http://www.herber.de/forum/archiv/1248to1252/1251754_Duplikate_finden_bei_groen_Datenmengen.html#1251798

hier mein aktueller Code:

Code:

---

'doppelte Einträge
       
        Dim oDic As Object
        Dim ArrayData() As Variant
        Dim ArrayAusgabe() As Variant
       
        Dim b As Long
        Set oDic = CreateObject("Scripting.Dictionary")
        ArrayData = varDaten
        For b = 1 To UBound(ArrayData)
           
            If oDic.exists(ArrayData(b, 1)) Then
                ArrayAusgabe(b, 1) = "duplicate"
               
                ArrayAusgabe(oDic(ArrayData(b, 1)), 1) = "duplicate"
               
                Else:
                oDic(ArrayData(b, 1)) = b
            End If
       
        Next b

---

Ich bekomme immer nur den Fehler "Laufzeitfehler "9" Index außerhalb des gültigen Bereichs"
Beim Debuggen wird die Zeile

Code:

---

If oDic.exists(ArrayData(b, 1)) Then

---

angemarkert.

Lösungsvorschläge?

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich habe deinen Code nicht ausprobiert und bin jetzt nicht so fit in VBA, aber muß man da nicht die Größe des Arrays irgendwo festlegen oder mit ReDim anpassen.
Gruß
Andi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Andi,

ja, das stimmt. Hier die aktuelle Funktion:

Code:

---

Function Doppelte_Eintraege(ArrayData As Variant)
'#####################################
'Code für ein allgemeines Modul
'Code sucht innerhalb der Markierung nach doppelten Datensätzen
'Autor: Jürgen Hennekes
'#####################################

    Dim objDic As Object
    Dim strMsg As String
    Dim iDoppelt As Integer
   
    iDoppelt = 0
    Set objDic = CreateObject("Scripting.Dictionary")
    strMsg = "Folgende Einträge sind doppelt:" & vbCr & vbCr

        For n = 1 To UBound(ArrayData)
       
            If ArrayData(n) <> "" Then
                If objDic.exists(ArrayData(n)) = False Then
                    'Daten nicht doppelt -> aus Array entfernen
                    'objDic(ArrayData(n)) = 0
                    objDic.Remove (ArrayData(n))
                Else
                    'Daten doppelt
                    strMsg = strMsg & ArrayData(n) & vbCr
                    iDoppelt = iDoppelt + 1
                End If
   
            End If

            Next n
   
    'Array nur noch vorhandene auf Daten einkürzen
    ReDim Preserve ArrayData(iDoppelt)
       
    MsgBox strMsg
End Function

---

Derzeit scheitert das Ganze an der Zeile

Code:

---

objDic.Remove (ArrayData(n))

---

Hier wird folgender Fehler ausgegeben:
Laufzeitfehler 32811
Anwendungs- oder objektdefinierter Fehler

Kann Inventor VBA kein "Remove"?
Wo liegt der Fehler?

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

du machst ein Remove bevor überhaupt etwas in "objDic" reingeschrieben wird, daher kommt der error

Gruß
Berno

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Berno,

vielen Dank für deinen Hinweis. Das habe ich nun auch verstanden    .

Meine Lösung ist nun, dass ich parallel ein zweites Array aufbaue und mit den doppelten Einträgen befülle.

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Nachtrag:
Hier der Code:

Code:

---

Function Doppelte_Eintraege(ArrayData As Variant)
'#####################################
'Code für ein allgemeines Modul
'Code sucht innerhalb der Markierung nach doppelten Datensätzen
'Autor: Jürgen Hennekes
'#####################################

    Dim objDic As Object
'    Dim strMsg As String
    Dim varDoppeltTemp As Variant
    Dim iDoppeltTemp As Integer
   
    iDoppeltTemp = 1
   
    ReDim varDoppeltTemp(1 To iDoppeltTemp)
    varDoppeltTemp(1) = "- keine doppelten Ansichten -"
   
    Set objDic = CreateObject("Scripting.Dictionary")
'    strMsg = "Folgende Einträge sind doppelt:" & vbCr & vbCr

        For n = 1 To UBound(ArrayData)
       
            If ArrayData(n) <> "" Then
                If objDic.exists(ArrayData(n)) = False Then
                    'Daten nicht doppelt -> aus Array entfernen
                    objDic(ArrayData(n)) = 0
                    'objDic.Remove ArrayData(n)

                Else
                    'Daten doppelt
                   
                    ReDim Preserve varDoppeltTemp(iDoppeltTemp)
                    varDoppeltTemp(iDoppeltTemp) = ArrayData(n)
                    iDoppeltTemp = iDoppeltTemp + 1
                   
'                    strMsg = strMsg & ArrayData(n) & vbCr
               
                End If
   
            End If

        Next n
       
        'ArrayData leeren
        Erase ArrayData
        ReDim ArrayData(1 To iDoppeltTemp)
       
        ArrayData = varDoppeltTemp
       
       
'    MsgBox "Anzahl ArrayData: " & objDic.Count & "Doppelt: " & iDoppelt

'    MsgBox strMsg

End Function

---

Das geht sicherlich noch viiieeeel eleganter... 

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP