Daten Übertragung mit Dialogfenster und Abfrage

[schauan]

Hallöchen,

wenn ich bei mir z.B. 451056 eingebe, habe ich anschließend die Daten dazu. Hast Du den Code auch an der richtigen Stelle?

Private Sub ComboBox1_Change()
If IsError(Application.Match(Val(ComboBox1), WorksheetFunction.Transpose(ComboBox1.List), 0)) Then Exit Sub
'If Not ComboBox1.MatchFound Then Exit Sub
ListBox1.Clear
'Variablendeklarationen - Integer (%)
…

   
   

[Pirat2015]

wir haben den Code etwas umgeschrieben also momentan sieht es so

Code:

Private Sub ComboBox1_Change()
If IsError(Application.Match(Val(ComboBox1), WorksheetFunction.Transpose(ComboBox1.List), 0)) Then Exit Sub
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
If Len(Me.ComboBox1.Value) >= 11 Then Exit Sub
'Schleifenzaehler auf 18 setzen (Anfangszeile in Quelle)
icnt1 = 18
'die Spalten, die in die Listbox kommen sollen
vntSpalten = Array(14, 21, 22, 23, 24, 25, 29, 30, 32, 38, 39, 42, 62, 63, 36)
'Schleife solange bis in Spalte 38 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 "Purchase order (PO) not found"
End If
End Sub

So sehe keine Daten

und die ComboBox wir gleich mit daten gefüllt, in der Tabelle die ich gepostet habe ist es nich so

[schauan]

Hallöchen,
bei mir klappt's auch mit Deinem Code ...

[Pirat2015]

aber warum wird die ComboBox in der Tabelle welche ich gepostet habe nicht gleich gefüllt und bei mir wird diese gleich gefüllt?

[schauan]

Hallöchen,

die Combobox wird nicht vom Makro "Private Sub ComboBox1_Change()" gefüllt sondern vom Makro "Private Sub UserForm_Initialize()"
"Private Sub ComboBox1_Change()" ist ein Ereignismakro welches auf die Änderung im Eingabefeld der Combobox reagiert: Change = Änderung

[Pirat2015]

Mal andere Frage, wenn ich bei Übertragung der Daten in die Quelle auch gleich zeitig abgefragt haben möchte, ob auch die Daten ausgedruckt werden sollen und beim Ja sollen 4 Daten aus der Listbox in eine Vorlage, welche als Tabelle hängt, wie soll ich das machen und vor allem die weiße ich zu welche daten aus der ListBox in welche Zelle kommen und dann wenn ich sagen wir mal 10 Daten ausgewählt habe, werden diese nach einander gedruckt? Also zuerst kommen 4 Daten von Material A, dann wird lebel erstellt, die Daten von Material A werden gelöscht und die Daten von Material B werden in die gleiche vorlage eingetragen oder wie läuft das sonst

---

der wurde auch etwas umgeschrieben und zwar so

Code:

Private Sub UserForm_Initialize()
Dim iCnt%
Dim objDic
'Zaehler auf 18 setzen
iCnt = 18
Set objDic = CreateObject("scripting.dictionary")
'Schleife solange bis in Spalte 38 eine Zelle ohne Inhalt kommt
Do While Cells(iCnt, 38) <> ""
  'Wenn der Zellinhalt unterschiedlich zum vorherigen Eintrag ist, dann in Combo uebernehmen
  If Not objDic.exists(Cells(iCnt, 38).Value) Then objDic(Cells(iCnt, 38).Value) = objDic(Cells(iCnt, 38).Value) + 1
  'Schleifenzehler hochsetzen
  iCnt = iCnt + 1
'Ende Schleife solange bis in Spalte 38 eine Zelle ohne Inhalt kommt
Loop
Me.ComboBox1.List = objDic.keys
Set objDic = Nothing
End Sub

kannst du mir bitte die Cods angleichen

[Pirat2015]

Andre kannst du nochmal schauen bitte.

[schauan]

Hallo,

das musst Du in dem Code vom CommandButton verarbeiten.

Private Sub CommandButton1_Click()

Da tust Du ja die Inhalte aus der Listbox in das Ziel übertragen und da kannst Du die Daten auch gleich in Deine Label geben.


Dort hast Du dieses Codestück:

'Mit dem Zielblatt
With Workbooks("Ziel.xlsx").Sheets("Tabelle1")
'mit der ersten lleren Zelle (anhand Spalte 6)
With .Cells(.Cells(.Rows.Count, 6).End(xlUp).Row + 1, 6)
'Eintraege der Listbox uebernehmen, Spalten 4 bis 7 - Zaehlung beginnt bei 0!
.Value = ListBox1.List(iCnt1, 3)
.Offset(, 1) = ListBox1.List(iCnt1, 4)
.Offset(, 2) = ListBox1.List(iCnt1, 5)
.Offset(, 5) = ListBox1.List(iCnt1, 6)
'Ende mit der ersten lleren Zelle (anhand Spalte 6)
End With
'Ende Mit dem Zielblatt
End With

Da könntest Du dann die Einträge für das Label drin verpacken oder dranhängen

Code:

'Ende Mit dem Zielblatt
  End With
      Range("Label").Cells(1, 1).Value = ListBox1.List(iCnt1, 3)
      Range("Label").Cells(2, 1).Value = ListBox1.List(iCnt1, 4)
      Range("Label").Cells(3, 1).Value = ListBox1.List(iCnt1, 5)
      Range("Label").Cells(4, 1).Value = ListBox1.List(iCnt1, 6)

oder

Code:

'Ende Mit dem Zielblatt
  End With
  'Mit dem Blatt Label
  With Sheets("Label")
      .Cells(1, 1).Value = ListBox1.List(iCnt1, 3)
      .Cells(2, 2).Value = ListBox1.List(iCnt1, 4)
      .Cells(3, 1).Value = ListBox1.List(iCnt1, 5)
      .Cells(4, 2).Value = ListBox1.List(iCnt1, 6)
  'Ende Mit dem Blatt Label
  End With

oder irgendwie anders … Du kannst ja die Zelladressen auch variabel machen und alles untereinander schreiben.
Und dann kommt noch das Drucken dazu. Da könntest Du aber einen anderen Button nehmen. (Code könnte man aufzeichnen)
Und dann könnte man das Labelblatt am Anfang noch Leeren, aber das vielleicht gleich unter Private Sub CommandButton1_Click() (Code könnte man aufzeichnen)
Und dann könnte man noch …

[Pirat2015]

Hallo Andre,

Vielen Dank, habe so gelöst

[Pirat2015]

Andre eine frage habe ich noch zu den Label.

Wenn ich in der ListBox 3 Materialien auswähle, wie kann ich den Makro sagen er soll meine Vorlage (welche in den Anderen Sheet) nach einander füllen?
Momentan habe ich es so

Code:

If MsgBox("Willst du das Label Drucken?", vbYesNo) = vbYes Then
      Set sheet = ActiveWorkbook.Sheets("Label")
      'label zellen
      sheet.Cells(1, 2) = ListBox1.List(icnt1, 12)
      sheet.Cells(2, 2) = ListBox1.List(icnt1, 1)
      sheet.Cells(3, 2) = ListBox1.List(icnt1, 2)
      sheet.Cells(4, 2) = ListBox1.List(icnt1, 3)
      sheet.Cells(5, 2) = ListBox1.List(icnt1, 14)
      sheet.Cells(6, 2) = ListBox1.List(icnt1, 11)
      sheet.Cells(7, 2) = ListBox1.List(icnt1, 9)
      sheet.Cells(7, 4) = ListBox1.List(icnt1, 10)
      'Tabelle1.PrintPreview
         'Do stuff to print
        End If

Wenn ich jetzt hier z.b drei Sachen aus der ListBox auswähle, dann bekomme ich den Label jeweils für die Letze Position angezeigt, ich möchte aber alle drei Labes haben.