Daten Übertragung mit Dialogfenster und Abfrage

[Pirat2015]

poste dein Code bitte

[Steffl]

Hallo,

den brauche ich nicht zu posten, denn er entspricht genau dem, den Du als Screenpost im letzten Post hinzugefügt hast.

[Pirat2015]

aber du siehts es ist gelb also hat es einen Fehler

[Steffl]

Hallo,

ja, das sehe ich. Aber ich kann dir versichern, dass es in der von dir geposteten Beispieldatei funktioniert. Wie es in deiner Originaldatei aussieht, weiß ich nicht. Ob in der Spalte AL die Bestellnummer als Zahlen stehen, als Texte, Formel oder sonst was. Fakt ist, das Excel nicht auswerten kann, wie oft eine Bestellnummer vorkommt und es somit bei der Dimensionierung des Array zu einen Fehler.

[Pirat2015]

nein es funktioniert nicht in deine datei, ich poste die Datei, schau mal die Tabelle an.

---

Ach der fehler kommt nur wenn du versucht in die ComboBox was zu schreiben, wenn du per Auswahl macht dann hats du recht es funktioniert.

Aber ich soll schon eine nummer reinschreiben dürfen, ich habe in der Tabelle ca. 1000 nummre bis ich die nötige per Ausfall finde dauert es sehr lange

[Steffl]

Hallo,

mal als Ansatz

Code:

Private Sub ComboBox1_Change()
ListBox1.Clear
'Variablendeklarationen - Integer (%)
Dim icnt1%, icnt2%
Dim vntSpalten As Variant
Dim vntArray() As Variant
Dim lngC As Long, lngA As Long, lngB As Long
'Schleifenzaehler auf 4 setzen (Anfangszeile in Quelle)
If Len(Me.ComboBox1.Value) <> 6 Then Exit Sub
icnt1 = 18
'die Spalten, die in die Listbox kommen sollen
vntSpalten = Array(14, 21, 22, 24, 25, 29, 30, 32, 38, 39, 42, 62, 63, 64)
'Schleife solange bis in Spalte 4 eine Zelle ohne Inhalt kommt
lngC = WorksheetFunction.CountIf(Columns(38), Me.ComboBox1.Value)
ReDim vntArray(0 To lngC - 1, 0 To UBound(vntSpalten))
Do While Cells(icnt1, 38) <> ""
  'Wenn der Zellinhalt der Auswahl entspricht, dann
  If Cells(icnt1, 38).Value = Val(Me.ComboBox1.Value) Then
    'Mit der Listbox ... (fuellen)
    For lngA = 0 To UBound(vntSpalten)
      vntArray(lngB, lngA) = Cells(icnt1, vntSpalten(lngA)).Value
    Next lngA
    lngB = lngB + 1
  'Ende Wenn der Zellinhalt der Auswahl entspricht, dann
  End If
  'Schleifenzaehler iCnt1 hochsetzen
  icnt1 = icnt1 + 1
'Ende Schleife solange bis in Spalte 4 eine Zelle ohne Inhalt kommt
Loop
Me.ListBox1.List = vntArray
End Sub

[Pirat2015]

gleiche fehler

[Steffl]

Hallo,

Code:

Private Sub ComboBox1_Change()
ListBox1.Clear
'Variablendeklarationen - Integer (%)
Dim icnt1%, icnt2%
Dim vntSpalten As Variant
Dim vntArray() As Variant
Dim lngC As Long, lngA As Long, lngB As Long
'Schleifenzaehler auf 4 setzen (Anfangszeile in Quelle)
If Len(Me.ComboBox1.Value) <> 6 Then Exit Sub
icnt1 = 18
'die Spalten, die in die Listbox kommen sollen
vntSpalten = Array(14, 21, 22, 24, 25, 29, 30, 32, 38, 39, 42, 62, 63, 64)
'Schleife solange bis in Spalte 4 eine Zelle ohne Inhalt kommt
lngC = WorksheetFunction.CountIf(Columns(38), Me.ComboBox1.Value)
If lngC > 0 Then
  ReDim vntArray(0 To lngC - 1, 0 To UBound(vntSpalten))
  Do While Cells(icnt1, 38) <> ""
    'Wenn der Zellinhalt der Auswahl entspricht, dann
    If Cells(icnt1, 38).Value = Val(Me.ComboBox1.Value) Then
      'Mit der Listbox ... (fuellen)
      For lngA = 0 To UBound(vntSpalten)
        vntArray(lngB, lngA) = Cells(icnt1, vntSpalten(lngA)).Value
      Next lngA
      lngB = lngB + 1
    'Ende Wenn der Zellinhalt der Auswahl entspricht, dann
    End If
    'Schleifenzaehler iCnt1 hochsetzen
    icnt1 = icnt1 + 1
    'Ende Schleife solange bis in Spalte 4 eine Zelle ohne Inhalt kommt
  Loop
  Me.ListBox1.List = vntArray
Else
  MsgBox "Bestellnummer nicht gefunden"
End If
End Sub

[Pirat2015]

alles ok

[Steffl]

Hallo,

dann gibt es für die Bestellnummer auch keine Daten.