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
    6. znr = 2
    8. Do While Cells(znr, 9) <> "" 'Solange Spalte I(9) nicht Leer ist
    10. ReDim Preserve Land(i)
    12. Land(i) = Cells(znr, 9) 'Werte aus Spalte I(9) dem Array Übergeben
    13. gefunden = False
    14. For i = 0 To UBound(Land)
    15. If Cells(znr, 9) = Land(i) Then
    16. gefunden = True
    17. Exit For
    18. End If
    19. Next
    20. If gefunden Then
    21. With Me.cmb_Laender
    22. .AddItem Cells(znr, 9)
    23. End With
    24. End If
    25. i = i + 1
    26. znr = znr + 1
    27. Loop
    28. Me.cmb_Laender.ListIndex = 0
    29. 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
    5. Dim lastRow As Integer
    6. Dim cell As Range
    7. Dim DynamicCountryArray() As String
    8. Dim arrayEntry As Variant
    10. With Worksheets("Tabelle1")
    11. lastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row 'letzte Zeile in Spalte 1
    13. 'initialize array
    14. ReDim DynamicCountryArray(0)
    16. 'iterate cells and add distinct countries
    17. For Each cell In .Range(.Cells(StartAtRow, SearchColumn), .Cells(lastRow, SearchColumn))
    19. If Not EntryExists(DynamicCountryArray, cell.Value2) Then
    21. 'set country
    22. DynamicCountryArray(UBound(DynamicCountryArray)) = cell.Value2
    24. 'add new empty entry
    25. ReDim Preserve DynamicCountryArray(UBound(DynamicCountryArray) + 1)
    26. End If
    28. Next cell
    30. 'delete last entry cause its always empty
    31. ReDim Preserve DynamicCountryArray(UBound(DynamicCountryArray) - 1)
    33. End With
    35. 'debug print to show result (STRG + G for debugginng window)
    36. For Each arrayEntry In DynamicCountryArray
    37. Debug.Print arrayEntry
    38. Next arrayEntry
    41. End Sub
    43. 'this function checks, if the searchValue is an element of the given array
    44. Private Function EntryExists(ByRef ar() As String, searchValue As String)
    45. Dim found As Boolean
    46. Dim entry As Variant
    48. found = False
    50. For Each entry In ar
    51. If entry = searchValue Then
    52. found = True
    53. Exit For
    54. End If
    55. Next entry
    57. EntryExists = found
    58. End Function


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

Facebook
Telefonspende