Anzeige
Archiv - Navigation
1840to1844
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

WorksheetFunction.Transpose

WorksheetFunction.Transpose
26.07.2021 09:30:09
Thomas
Hallo Excelfreunde,
ich filtere mit dem folgendem Makro meine Listbox:
'Macro Grundlage ransi 2007

Private Sub CommandButton1_Click()
Dim arr
Dim I As Integer
Dim K As Long
Dim out As Variant
Dim L As Long
Dim dblStart As Double
dblStart = Timer
Tabelle1.Range("a2:x200") = ""
Suchergebnisse_suchen.Clear
arr = Sheets("Kundendaten").Range("A2:X60")
ReDim out(1 To UBound(arr, 2), 1 To UBound(arr))
For L = 1 To UBound(arr)
'filter setzen
If arr(L, 1) = TextBox1.Text Then  'Tabelle7.Range("a2").Value Then '> 1000 Then '    'TextBox1.Value Dein "Filter
'If Rows(L).RowHeight > 0 Then ' nur sichtbare laden
K = K + 1
For I = 1 To UBound(arr, 2)
out(I, K) = arr(L, I)
Next
End If
Next
On Error Resume Next
ReDim Preserve out(1 To I - 1, 1 To K)
On Error GoTo 0
out = WorksheetFunction.Transpose(out)
Suchergebnisse_suchen.List = out
'Range(„C“&i)=Range(„B“&i)
Tabelle1.Range("a2:x" & K + 1) = out
'MsgBox Timer - dblStart
End Sub
Soweit klappt dies schon ganz gut.
Wenn es jedoch nur einen Treffer gibt funktioniert das " WorksheetFunction.Transpose" einfach nicht.
Der gefundene Datensatz wird in der Listbox untereinander dargestellt. Bei mehreren Treffern wird die Listbox richtig gefüllt.
Die Ausgabe auf einem Tabellenblatt funktioniert jedoch tadellos.
Kann sich jemand mal anschauen was ich da falsch mache?
Anbei noch die Testmappe.
https://www.herber.de/bbs/user/147301.xlsm
habt schon mal rechtvielen dank für euer Interesse.
mfg thomas

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: WorksheetFunction.Transpose
26.07.2021 10:23:23
Rudi
Hallo,
nutze eine eigene Funktion:

Function myTranspose(arr)
Dim i As Long, j As Long
Dim tmp
ReDim tmp(LBound(arr, 2) To UBound(arr, 2), LBound(arr) To UBound(arr))
For i = LBound(arr) To UBound(arr)
For j = LBound(arr, 2) To UBound(arr, 2)
tmp(j, i) = arr(i, j)
Next j
Next i
myTranspose = tmp
End Function
out=myTranspose(out) statt out = WorksheetFunction.Transpose(out)
Gruß
Rudi
besten dank an Rudi
26.07.2021 10:30:40
Thomas
Hallo Rudi,
das funktioniert tadellos.
Hab rechtvielen dank.
Ich wünsch dir noch einen ruhigen Tag.
mfg thomas
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige