AW: Listbox mit gefilterten Daten füllen
06.09.2017 16:14:37
Nepumuk
Hallo Markus,
teste mal:
Private Sub UserForm_Activate()
Dim objDataObject As DataObject
Dim avntInput As Variant, avntRow As Variant
Dim avntOutput() As Variant
Dim ialngRow As Long, ialngColumn As Long
Dim strTemp As String
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'gefilterte Liste ohne Überschriften kopieren
With Tabelle1.AutoFilter.Range
Range(.Cells(2, 2), .Cells(.Rows.Count, 12)).Copy
End With
'neue Instanz des Data-Objektes anlegen
Set objDataObject = New DataObject
'Inhalt der Zwischenablage in das Data-Objekt holen
objDataObject.GetFromClipboard
With Application
'Zwischenablage löschen (entfernt den Ameisenrahmen)
.CutCopyMode = False
'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True
End With
'Daten aus dem Data-Objekt in einen String übertragen
strTemp = objDataObject.GetText
'Data-Objekt zerstören
Set objDataObject = Nothing
'den letzten Zeilenumbruch entfernen
strTemp = Left$(strTemp, Len(strTemp) - 2)
'String in Zeilen aufteilen
avntInput = Split(strTemp, vbCrLf)
'Ausgabearray dimensionieren (die Split-Funktion erzeugt ein 0-basiertes Array)
Redim avntOutput(0 To UBound(avntInput, 1), 0 To 10)
'Schleife über alle Zeilen
For ialngRow = 0 To UBound(avntInput)
'Zeile in Spalten aufteilen
avntRow = Split(avntInput(ialngRow), vbTab)
'Schleife über alle Spalten
For ialngColumn = 0 To 10
'Daten in das Ausgabearray übertragen
avntOutput(ialngRow, ialngColumn) = avntRow(ialngColumn)
Next
Next
'Ausgabearray in die Listbox übertragen
ListBox1.List = avntOutput
End Sub
Gruß
Nepumuk