ListBox mehrfachauswahl übertragen

Hallo Zusammen
Ich wünsche allen noch ganz schöne und erholsame Feriertage und einen guten Rutsch ins neue Jahr.
Ich knoble mal wieder schon seit Stunden herum und weder Beispiele noch meine Hilfsmittel können mir helfen.
Folgendes Problem:
Habe eine ListBox mit Mehrfachauswahl in einer Userform.
Ich möchte diese Daten in eine oder mehere Zellen übertragen können.
Wie kriege ich diese Daten raus.
Mit der einfach Auswahl hat die super geklappt:


Private Sub Ok_Click()
Range("C4").Select
ActiveCell = Lst_Kunden.Value
Txt_Kunde = ""
Suche.Hide
End Sub

Wie kann ich nun die ausgewählten daten in eine oder mehrere Zellen schreiben.
Mir ist klar, das dies mit einer Schleife geschehen soll. Tja leider ergibt dies bei mir nur Zahlen?
Danke für eure Hilfe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
dies könnte so gehen.
Nicht ausgiebig getestet!
kommt in Deine Userform

Option Explicit 
 
Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias "GetMem4" _
                    (pArray() As Any, sfaPtr As Long) 
 
Private Sub UserForm_Activate() 
Dim i As Integer 
Dim sfaPtr As Long 
GetSafeArrayPointer myListSelect, sfaPtr 
 
With Lst_Kunden 
  
 If sfaPtr > 0 Then 
  For i = Lbound(myListSelect) To Ubound(myListSelect) 
    .Selected(myListSelect(i)) = True 
  Next i 
 End If 
 
End With 
 
End Sub 
 
Private Sub UserForm_Terminate() 
 Dim i As Integer, A As Integer 
  
 With Lst_Kunden 
    For i = 0 To .ListCount - 1 
     If .Selected(i) Then 
      Redim Preserve myListSelect(A) 
      myListSelect(A) = i 
      A = A + 1 
     End If 
    Next i 
 End With 
  
End Sub 
 
 
Private Sub Ok_Click() 
Dim i As Integer, LRow As Long 
   
  With Lst_Kunden 
      For i = 0 To .ListCount - 1 
          If .Selected(i) Then 
              ActiveCell.Offset(LRow, 0) = .List(i) 
              LRow = LRow + 1 'Zeile 
          End If 
      Next i 
  End With 
         
 Txt_Kunde = "" 
Unload Me 
End Sub

kommt in ein Modul

Option Explicit 
Public myListSelect() As Integer

Gruß Tino

Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias "GetMem4" _ (pArray() As Any, sfaPtr As Long) Private Sub LetzteEinstellung_Click() Dim i As Integer Dim sfaPtr As Long GetSafeArrayPointer myListSelect, sfaPtr With Lst_Kunden If sfaPtr > 0 Then For i = Lbound(myListSelect) To Ubound(myListSelect) .Selected(myListSelect(i)) = True Next i End If End With End Sub Private Sub UserForm_Terminate() Dim i As Integer, A As Integer Erase myListeSelect With Lst_Kunden For i = 0 To .ListCount - 1 If .Selected(i) Then Redim Preserve myListSelect(A) myListSelect(A) = i A = A + 1 End If Next i End With End Sub Private Sub Ok_Click() Dim i As Integer, LRow As Long With Lst_Kunden For i = 0 To .ListCount - 1 If .Selected(i) Then ActiveCell.Offset(LRow, 0) = .List(i) LRow = LRow + 1 'Zeile End If Next i End With Txt_Kunde = "" Unload Me End Sub

Private Sub Ok_Click() Range("F3").Select 'Ausgabe Zelle 1 ActiveCell.Clear 'Zelle leeren ActiveCell.Offset(1, 0).Activate 'eine Reihe nach unten While ActiveCell.Value 0 'prüfen ob Inhalt ActiveCell.Clear 'wenn ja leeren ActiveCell.Offset(1, 0).Activate 'eine Reihe nach unten Wend Range("F3").Select 'Ausgabe Zelle 1 Dim i As Integer, LRow As Long 'Variablen definition With Lst_Bearbeitungen For i = 0 To .ListCount - 1 If .Selected(i) Then ActiveCell.Offset(LRow, 0) = .List(i) 'Auswahl eintragen LRow = LRow + 1 'Zeile End If Next i End With UF_Bearbeitungen.Hide End Sub

Private Sub Ok_Click() Dim i As Integer, LRow As Long Range("F3:G" & Application.Max(3, Range("F65536").End(xlUp).Row)).Clear With LSt_Bearbeitungen LRow = 3 For i = 0 To .ListCount - 1 If .Selected(i) Then Range("F" & LRow) = .List(i, 0) Range("G" & LRow) = .List(i, 1) LRow = LRow + 1 End If Next End With UF -Bearbeitungen.Hide End Sub

Private Sub Ok_Click() Dim i As Integer, LRow As Long Range("F3:G" & Application.Max(3, Range("F65536").End(xlUp).Row)).Clear With LSt_Bearbeitungen LRow = 3 For i = 0 To .ListCount - 1 If .Selected(i) Then Range("F" & LRow) = .List(i, 0) Range("G" & LRow) = .List(i, 1) Range("G" & LRow).NumberFormat = "[$SFr.] #,##0.00" LRow = LRow + 1 End If Next End With UF -Bearbeitungen.Hide End Sub

Beliebteste Forumthreads (12 Monate)

ListBox mehrfachauswahl übertragen

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

ListBox mehrfachauswahl übertragen

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread