Spalte nach Werten in einem Array durchsuchen

  • Excel

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

    Spalte nach Werten in einem Array durchsuchen

    Hallo,

    ich bin wahrscheinlich zu blöd um die anderen Beiträge hier im Forum und bei google umzumünzen für mein Problem.

    So nun aber erstmal was sache ist.

    Ich habe eine UserForm mit einer textbox und 2 buttons. Ich möchte nun ein Wert in der Textbox eingeben und mit einem klick auf Button1 soll dieser Wert in ein Array gespeichert werden und die Textbox gesäubert werden. Und das für eine beliebige anzahl an werten (Hier hänge ich irgendwie, den so wie ich das in einer WPF anwendung machen würde, klappt es nicht). Wenn ich dann alle Werte eingegeben habe klicke ich auf Button2 und nun soll eine Spalte (Range B:B) nach den Werten durchsucht werden.

    Das Suchen und alles was danach passieren soll, bekomme ich hin. Ich schaffe es nur nicht das Array zu programmieren mit dem Button1.

    VB.NET-Quellcode

    1. Dim i As Integer
    2. i = 1
    3. Dim Aufträge(1 To 19) As String
    4. Dim wbMappe1 As Workbook
    5. Set wbMappe1 = Application.Workbooks("Beobachten.xlsm")
    6. Dim wsAuftragsliste As Worksheet
    7. Set wsBeosys = wbMappe1.Worksheets("Auftragsliste")
    8. Dim wsBeobachten As Worksheet
    9. Set wsAirSupply = wbMappe1.Worksheets("Beobachten")
    10. Private Sub bnFertig_Click()
    11. Dim j As Integer
    12. j = i
    13. Dim rng As Range
    14. For i = 1 To j
    15. Set rng = wsAuftragsliste.Range("B:B").Find(Aufträge(i)) 'Zähler der Reihe in Aufträgen inkl. Suchen
    16. If rng Is Nothing Then
    17. 'Nicht vorhanden = Ende der If-Schleife
    18. Else
    19. 'Hat was gefunden
    20. rng.EntireRow.Copy 'Zeile aus der Auftragsliste kopieren
    21. wsBeobachten.Cells(Rows.Count, "A").End(xlUp) _
    22. .Offset(1, 0).PasteSpecial Paste:=xlPasteAll 'und einfügen
    23. End If
    24. Next i 'Nächste Zeile abfragen
    25. End Sub
    26. Private Sub bnNächster_Click()
    27. Aufträge(i) = TB.Text
    28. TB.Text = ""
    29. i = i + 1
    30. End Sub
    Hallo,

    eine Möglichkeit zum Array füllen wäre:
    Code der Textbox_Keyup

    Visual Basic-Quellcode

    1. Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    2. If KeyCode = 13 Then
    3. If Trim(TextBox1.Text) <> "" Then
    4. Hinzu TextBox1.Text
    5. TextBox1.Text = ""
    6. End If
    7. End If
    8. End Sub


    Dann in einem Modul noch:

    Visual Basic-Quellcode

    1. Dim Arr As Variant
    2. Public Sub Hinzu(ByVal S As String)
    3. Dim i As Long
    4. If IsEmpty(Arr) Then
    5. ReDim Arr(0) As String
    6. Else
    7. ReDim Preserve Arr(UBound(Arr) + 1)
    8. End If
    9. Arr(UBound(Arr)) = S
    10. For i = 0 To UBound(Arr)
    11. Debug.Print Arr(i) & ",";
    12. Next
    13. Debug.Print
    14. End Sub


    Edit:
    Nach Möglichkeit keine Umlaute und Sonderzeichen in Variablen- Funktions- und Subs- Namen verwenden.

    Edit2:
    Solle auch alles im Codeteil der Form laufen. Modul ist nicht unbedingt notwendig.
    Code der Form ohne Modul lauffähig:

    Visual Basic-Quellcode

    1. Option Explicit
    2. Dim Arr As Variant
    3. Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    4. If KeyCode = 13 Then
    5. If Trim(TextBox1.Text) <> "" Then
    6. Hinzu TextBox1.Text
    7. TextBox1.Text = ""
    8. End If
    9. End If
    10. End Sub
    11. Private Sub Hinzu(ByVal S As String)
    12. Dim i As Long
    13. If IsEmpty(Arr) Then
    14. ReDim Arr(0) As String
    15. Else
    16. ReDim Preserve Arr(UBound(Arr) + 1)
    17. End If
    18. Arr(UBound(Arr)) = S
    19. For i = 0 To UBound(Arr)
    20. Debug.Print Arr(i) & ",";
    21. Next
    22. Debug.Print
    23. End Sub

    Gruß
    Peterfido

    Keine Unterstützung per PN!

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

    Hallo,
    danke für die Antwort.
    Der Wert der in der Textbox stehen wird ist definitiv immer eine Zahlenreihnfolge.

    Ist dein "i as Long" die Zählvariabel wieviele einträge in dem Array sind?
    Für meine For-Schleife in der der Suchen und Kopiervorgang statt findet wäre das von Vorteil.

    Wenn ich die Enter-Taste drücke passiert nix. Das Textfeld wird nicht geleert und anscheinden auch nix ins Array geschrieben.

    VB.NET-Quellcode

    1. Option Explicit
    2. Dim Arr As Variant 'Array
    3. Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    4. If KeyCode = 13 Then 'Keycode = 13 = Entertaste
    5. If Trim(TextBox1.Text) <> "" Then
    6. Hinzu TextBox1.Text 'Aufrufen der Sub zum Werte hinzufügen
    7. TextBox1.Text = "" 'Leeren der TB
    8. End If
    9. End If
    10. End Sub
    11. Public Sub Hinzu(ByVal S As String) 'Wert ins Array schreiben
    12. Dim i As Long 'Zählvariabel?
    13. If IsEmpty(Arr) Then
    14. ReDim Arr(0) As String
    15. Else
    16. ReDim Preserve Arr(UBound(Arr) + 1)
    17. End If
    18. Arr(UBound(Arr)) = S
    19. For i = 0 To UBound(Arr)
    20. Debug.Print Arr(i) & ",";
    21. Next
    22. Debug.Print
    23. End Sub
    24. Private Sub bnFertig_Click() 'Anfangen zu Suchen und zu Kopieren
    25. Dim j As Integer
    26. Dim rng As Range
    27. For i = 1 To j
    28. Set rng = wsAuftragsliste.Range("B:B").Find(Aufträge(i)) 'Zähler der Reihe in Aufträgen inkl. Suchen
    29. If rng Is Nothing Then
    30. 'Nicht vorhanden = Ende der If-Schleife
    31. Else
    32. 'Hat was gefunden
    33. rng.EntireRow.Copy 'Zeile aus der Auftragsliste kopieren
    34. wsBeobachten.Cells(Rows.Count, "A").End(xlUp) _
    35. .Offset(1, 0).PasteSpecial Paste:=xlPasteAll 'und einfügen
    36. End If
    37. Next i 'Nächste Zeile abfragen
    38. End Sub
    Bilder
    • UserForm.png

      2,35 kB, 353×128, 179 mal angesehen
    Hallo,

    damit das klappt, braucht die Textbox den Fokus. Den hat diese normal, wenn man gerade was eingetippt hat. Ansonsten einfach mal im Direktfenster keycode ausgeben und schauen, was da bei Enter kommt. Bei meinem Test hatte ich da keine Probleme mit. Heißt denn Deine Textbox auch Textbox1?

    Visual Basic-Quellcode

    1. debug.print Keycode


    Ansonsten hast Du das schon richtig erkannt. Ich nutze i um das Array im Direktfenster auszugeben.
    Gruß
    Peterfido

    Keine Unterstützung per PN!
    1. Meine Textbox heißt auch TextBox1
    2. Wenn ich alles richtig gemacht habe, musste dafür ein wenig googeln da ich noch nie mit dem Direktfenster gearbeitet habe, kommt kein KeyCode 13. Habe sogar eine Sub erstellt UserForm_Activate und dort TextBox1.SetFocus eingetragen. Auch das hat nix geholfen.
    3. Ist es nicht möglich das über den Button "Nächster" zu machen? Dem Button kann ich ja sagen das er Default ist und damit immer beim drücken der Return taste gedrückt wird.
    Hallo,

    na klar, kannst Du lösen, wie Du möchtest. Evtl. heisst die Sub unter anderen Excel-Versionen auch nur anders. Einfach mal in die Textbox doppelklicken (im Wntwurfsmodus) und schauen, ob es da überhaupt ein Key_Down / Key_Up Event gibt.

    Ob Excel auch KeyPreview für die Userform anbietet, kann ich grad nicht sagen. Habe diese Woche kein Office zur Verfügung.
    Gruß
    Peterfido

    Keine Unterstützung per PN!
    Lösung Nr. 1 funktioniert. UserForm wird geladen, Einträge werden gespeichert und die Suche inkl. kopieren läuft. Will ich dann aber ein 2tes mal Suchen lassen, kommt eine Fehlermeldung die sich auf Zeile 18 bezieht.

    VB.NET-Quellcode

    1. Option Explicit
    2. Dim Arr As Variant 'Array
    3. Dim i As Integer
    4. Private Sub bnNächster_Click()
    5. If Trim(TextBox1.Text) <> "" Then
    6. Hinzu TextBox1.Text 'Aufrufen der Sub zum Werte hinzufügen
    7. TextBox1.Text = "" 'Leeren der TB
    8. End If
    9. TextBox1.SetFocus
    10. End Sub
    11. Public Sub Hinzu(ByVal S As String) 'Wert ins Array schreiben
    12. If IsEmpty(Arr) Then
    13. ReDim Arr(0) As String
    14. Else
    15. ReDim Preserve Arr(UBound(Arr) + 1)
    16. End If
    17. Arr(UBound(Arr)) = S
    18. For i = 0 To UBound(Arr)
    19. Debug.Print Arr(i) & ",";
    20. Next
    21. End Sub
    22. Private Sub bnFertig_Click() 'Anfangen zu Suchen und zu Kopieren
    23. 'Deklarieren von Variabeln und Arbeitsmappen
    24. Dim j As Integer
    25. j = i
    26. Debug.Print j
    27. Dim rng As Range
    28. Dim wbMappe1 As Workbook
    29. Set wbMappe1 = Application.Workbooks("Beobachten.xlsm")
    30. Dim wsListe As Worksheet
    31. Set wsListe = wbMappe1.Worksheets("Auftragsliste")
    32. Dim wsWatch As Worksheet
    33. Set wsWatch = wbMappe1.Worksheets("Beobachten")
    34. '_____________________________________________________________________________________
    35. If TextBox1.Text = "" Then
    36. Else
    37. If Trim(TextBox1.Text) <> "" Then
    38. Hinzu TextBox1.Text 'Aufrufen der Sub zum Werte hinzufügen
    39. TextBox1.Text = "" 'Leeren der TB
    40. End If
    41. End If
    42. 'Suchenschleife
    43. For i = 0 To j
    44. Set rng = wsListe.Range("B:B").Find(Arr(i), LookIn:=xlValues, LookAt:=xlWhole) 'Zähler der Reihe in Aufträgen inkl. Suchen
    45. If rng Is Nothing Then
    46. 'Nicht vorhanden = Ende der If-Schleife
    47. Else
    48. 'Hat was gefunden
    49. rng.EntireRow.Copy 'Zeile aus der Auftragsliste kopieren
    50. wsWatch.Cells(Rows.Count, "A").End(xlUp) _
    51. .Offset(1, 0).PasteSpecial Paste:=xlPasteAll 'und einfügen
    52. End If
    53. Next i 'Nächste Nummer abfragen
    54. UF.Hide
    55. Erase Arr
    56. End Sub


    Nach Rücksprache mit den beteiligten Personen kam auch die möglichkeit auf einen festen Datensatz einzugeben.
    Die Lösung sieht dann so aus und auch diese funktioniert einwandfrei.

    VB.NET-Quellcode

    1. Sub Suchen2()
    2. Dim Suchen, i As Integer
    3. Dim rng As Range
    4. Dim wbMappe1 As Workbook
    5. Set wbMappe1 = Application.Workbooks("Beobachten.xlsm")
    6. Dim wsListe As Worksheet
    7. Set wsListe = wbMappe1.Worksheets("Auftragsliste")
    8. Dim wsWatch As Worksheet
    9. Set wsWatch = wbMappe1.Worksheets("Beobachten")
    10. Suchen = Array("359970", _
    11. "359972", _
    12. "361305", _
    13. "361895", _
    14. "362177", _
    15. "362257", _
    16. "362353", _
    17. "362366", _
    18. "362538", _
    19. "359099", _
    20. "361125", _
    21. "359030", _
    22. "360741", _
    23. "361457", _
    24. "362406", _
    25. "362401", _
    26. "362402", _
    27. "362686", _
    28. "362194")
    29. For i = LBound(Suchen) To UBound(Suchen)
    30. Set rng = wsListe.Range("B:B").Find(Suchen(i))
    31. If rng Is Nothing Then
    32. Else
    33. rng.EntireRow.Copy 'Zeile aus der Auftragsliste kopieren
    34. wsWatch.Cells(Rows.Count, "A").End(xlUp) _
    35. .Offset(1, 0).PasteSpecial Paste:=xlPasteAll 'und einfügen
    36. End If
    37. Next i
    38. End Sub


    Danke für die Hilfe :) Vielleicht finden wir noch eine Lösung für das Problem mit der Fehlermeldung.