Dynamisches Array auf Duplikate prüfen

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von Karsa_Orlong.

    Dynamisches Array auf Duplikate prüfen

    Hallo,

    Bin Blutiger Anfänger im VBA Bereich und brauche Hilfe,,,Ich soll hier aus Tabelle 1 Spalte 9(I) eine ComboBox mit einem Dynamischen Array füllen ohne das ein Land doppelt vorkommt .
    Mein Code ist gerade das Absolute Chaos und ich finde die richtige Lösung einfach nicht.Kann mir jemand Helfen

    Visual Basic-Quellcode

    1. Private Sub UserForm_Initialize()
    2. Dim Land() As String
    3. Dim i As Integer, znr As Integer
    4. Dim gefunden As Boolean
    5. znr = 2
    6. Do While Cells(znr, 9) <> "" 'Solange Spalte I(9) nicht Leer ist
    7. ReDim Preserve Land(i)
    8. Land(i) = Cells(znr, 9) 'Werte aus Spalte I(9) dem Array Übergeben
    9. gefunden = False
    10. For i = 0 To UBound(Land)
    11. If Cells(znr, 9) = Land(i) Then
    12. gefunden = True
    13. Exit For
    14. End If
    15. Next
    16. If gefunden Then
    17. With Me.cmb_Laender
    18. .AddItem Cells(znr, 9)
    19. End With
    20. End If
    21. i = i + 1
    22. znr = znr + 1
    23. Loop
    24. Me.cmb_Laender.ListIndex = 0
    25. End Sub


    Code-Tags eingefügt. ~Thunderbolt

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Thunderbolt“ ()

    Ich hab mal was zusammen geklimpert und hoffe es hilft dir weiter:

    Visual Basic-Quellcode

    1. Sub CountryTest()
    2. Const SearchColumn As Integer = 1 'column(number) to search in
    3. Const StartAtRow As Integer = 2
    4. Dim lastRow As Integer
    5. Dim cell As Range
    6. Dim DynamicCountryArray() As String
    7. Dim arrayEntry As Variant
    8. With Worksheets("Tabelle1")
    9. lastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row 'letzte Zeile in Spalte 1
    10. 'initialize array
    11. ReDim DynamicCountryArray(0)
    12. 'iterate cells and add distinct countries
    13. For Each cell In .Range(.Cells(StartAtRow, SearchColumn), .Cells(lastRow, SearchColumn))
    14. If Not EntryExists(DynamicCountryArray, cell.Value2) Then
    15. 'set country
    16. DynamicCountryArray(UBound(DynamicCountryArray)) = cell.Value2
    17. 'add new empty entry
    18. ReDim Preserve DynamicCountryArray(UBound(DynamicCountryArray) + 1)
    19. End If
    20. Next cell
    21. 'delete last entry cause its always empty
    22. ReDim Preserve DynamicCountryArray(UBound(DynamicCountryArray) - 1)
    23. End With
    24. 'debug print to show result (STRG + G for debugginng window)
    25. For Each arrayEntry In DynamicCountryArray
    26. Debug.Print arrayEntry
    27. Next arrayEntry
    28. End Sub
    29. 'this function checks, if the searchValue is an element of the given array
    30. Private Function EntryExists(ByRef ar() As String, searchValue As String)
    31. Dim found As Boolean
    32. Dim entry As Variant
    33. found = False
    34. For Each entry In ar
    35. If entry = searchValue Then
    36. found = True
    37. Exit For
    38. End If
    39. Next entry
    40. EntryExists = found
    41. End Function


    Das Hinzufügen zur Combobox fehlt hier noch.
    Gruß Murdoc