VBA Array, Inhalte auf nicht vorhandensein prüfen

  • Excel

Es gibt 8 Antworten in diesem Thema. Der letzte Beitrag () ist von Neptun.

    VBA Array, Inhalte auf nicht vorhandensein prüfen

    Hallöchen,

    ich hab da mal eine Frage:

    Ich versuche Einträge in einer Spalte zu finden die nicht im Array vorkommen und dann in der nächsten Spalte bei "nicht" gefundenen Treffer ein "L" einzutragen.

    Wenn ich If Mid(ws.Cells(i, 1), 2, 7) = arrHMV(j) Then ws.Cells(i, 2) = "L" verwende, werden die gefunden die im Array vorkommen.
    Wenn ich aber das Not eintrage (weil mir geht es ja um die nicht im Array vorkommen) werden alle Einträge in der Liste mit einem "L" versehen.
    Muss ich irgendwie anders vorgehen um das Not zu verwenden?

    Visual Basic-Quellcode

    1. Public Sub LetterLInserter()
    2. Dim arrHMV() As Variant
    3. Dim i, j As Integer
    4. Dim iRows As Long
    5. Set wb = ActiveWorkbook
    6. Set ws = wb.ActiveSheet
    7. iRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
    8. arrHMV = Array(1050010, _
    9. 1050011, _
    10. 1050012, _
    11. 1050013, _
    12. 1050014, _
    13. 1050020, _
    14. 1050021, _
    15. 1050022)
    16. Application.ScreenUpdating = False
    17. For i = 2 To iRows
    18. For j = LBound(arrHMV) To UBound(arrHMV)
    19. If Not Mid(ws.Cells(i, 1), 2, 7) = arrHMV(j) Then ws.Cells(i, 2) = "L"
    20. Next j
    21. Next i
    22. Application.ScreenUpdating = True
    23. End Sub


    Freue mich über Feedback. :)

    EDIT: Ich vermute ja mal, weil in der zweiten Schleife natürlich im jeweiligen Versuch ein nicht Vorhandensein passiert, dass ich die Schleife abändern muss, oder?
    Hallo Sam85,
    die Logik ist falsch. Ändere den Code mal so:

    Visual Basic-Quellcode

    1. Dim Gefunden As Boolean
    2. For i = 2 To iRows
    3. Gefunden = False
    4. For j = LBound(arrHMV) To UBound(arrHMV)
    5. If Mid$(ws.Cells(i, 1), 2, 7) = arrHMV(j) Then
    6. Gefunden = True
    7. Exit For
    8. End If
    9. Next j
    10. If Gefunden = False Then ws.Cells(i, 2) = "L"
    11. Next i
    Gruss,

    Neptun
    @MrTrebron
    Hätte ich es mit einem Dictionary noch einfacher gestalten können? Wie hätte es mit dict.Exists() funktioniert? Oder sowas wie das hier Link

    @Neptun
    So hat es funktioniert, hatte bereits versucht das Dictionary einzubinden...versucht die BruteForce abzuwenden :). Bewirkt das Mid$() etwas besonderes?

    Vielen Dank an euch beide

    Visual Basic-Quellcode

    1. Public Sub LDict()
    2. Dim wb As Workbook, ws As Worksheet
    3. Dim dict As Scripting.Dictionary
    4. Dim arr, key As Variant
    5. Dim i As Integer
    6. Dim iRows As Long
    7. Dim Fund As Boolean
    8. Set wb = ActiveWorkbook
    9. Set ws = wb.ActiveSheet
    10. Set dict = New Scripting.Dictionary
    11. iRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
    12. arr = Array(1050010, _
    13. 1050011, _
    14. 1050012, _
    15. 1050013, _
    16. 1050014, _
    17. 1050020, _
    18. 1050021, _
    19. 1050022)
    20. For i = LBound(arr) To UBound(arr)
    21. dict.Add key:=arr(i), Item:=i
    22. Next i
    23. For i = 2 To iRows
    24. Fund = False
    25. For Each key In dict.Keys
    26. If Mid$(ws.Cells(i, 1), 2, 7) = key Then
    27. Fund = True
    28. Exit For
    29. End If
    30. Next key
    31. If Fund = False Then ws.Cells(i, 2) = "L"
    32. Next i
    33. End Sub

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Sam85“ ()

    Du könntest anstatt dein Array mit

    Visual Basic-Quellcode

    1. ​arr = Array(x, y, z)
    zu füllen ein Dictionary mit der Hilfsfunktion aus dem von dir verlinken Thread füllen.
    Exists() liefert dir zurück ob ein Item besteht. So muss du nicht selbst durch dein Array loopen sondern nur jeden Wert einmal auf Vorhanden sein abfragen.
    Die deutsche Sprache ist Freeware, du kannst sie benutzen, ohne dafür zu bezahlen. Sie ist aber nicht Open Source, also darfst du sie nicht verändern, wie es dir gerade passt.
    @MrTrebron

    Danke so funktioniert es, zumindest wenn ich die Daten im Array in "" setze. Kann ich das auch irgendwie anpassen oder muss ich die Werte als String in den Array einfügen?

    Visual Basic-Quellcode

    1. Public Sub LetterInserter()
    2. Dim wb As Workbook, ws As Worksheet
    3. Dim dict As Dictionary
    4. Dim arr As Variant
    5. Dim i, iRows As Long
    6. Set wb = ActiveWorkbook
    7. Set ws = wb.ActiveSheet
    8. iRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
    9. arr = Array("1050010", _
    10. "1050011", _
    11. "1050012", _
    12. "1050013", _
    13. "1050014", _
    14. "1050020", _
    15. "1050021", _
    16. "1050022")
    17. Set dict = GetDict(arr)
    18. Application.ScreenUpdating = False
    19. For i = 2 To iRows
    20. If Not dict.Exists(Mid$(ws.Cells(i, 1), 2, 7)) Then ws.Cells(i, 2).Value = "L" Else ws.Cells(i, 2).ClearContents
    21. Next i
    22. Application.ScreenUpdating = True
    23. End Sub


    Visual Basic-Quellcode

    1. Public Function GetDict(ByVal keyArr As Variant) As Scripting.Dictionary
    2. Dim dict As New Scripting.Dictionary
    3. Dim lng As Long
    4. For lng = LBound(keyArr) To UBound(keyArr)
    5. dict.Add key:=keyArr(lng), Item:=lng
    6. Next lng
    7. Set GetDict = dict
    8. End Function

    @MrTrebron
    Vielen Dank, so ist es wesentlich eleganter :).

    Spoiler anzeigen


    Visual Basic-Quellcode

    1. Public Sub LetterInserter()
    2. Dim wb As Workbook, ws As Worksheet
    3. Dim dict As Dictionary
    4. Dim arr As Variant
    5. Dim lng, lngRows As Long
    6. Set wb = ActiveWorkbook
    7. Set ws = wb.ActiveSheet
    8. lngRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
    9. arr = Array(1050010, _
    10. 1050011, _
    11. 1050012, _
    12. 1050013, _
    13. 1050014, _
    14. 1050020, _
    15. 1050021, _
    16. 1050022)
    17. Set dict = GetDict(arr)
    18. Application.ScreenUpdating = False
    19. For lng = 2 To lngRows
    20. If Not dict.Exists(Mid$(ws.Cells(lng, 1).Value, 2, 7)) Then ws.Cells(lng, 2).Value = "L" Else ws.Cells(lng, 2).ClearContents
    21. Next lng
    22. Application.ScreenUpdating = True
    23. End Sub


    Visual Basic-Quellcode

    1. Public Function GetDict(ByVal keyArr As Variant) As Scripting.Dictionary
    2. Dim dict As New Scripting.Dictionary
    3. Dim lng As Long
    4. For lng = LBound(keyArr) To UBound(keyArr)
    5. dict.Add CStr(keyArr(lng)), lng
    6. Next lng
    7. Set GetDict = dict
    8. End Function


    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Sam85“ ()