Listbox zeigt bei gefilterte Daten...

Guten Abend,
irgendwie übersehe ich etwas, ich hoffe eine oder ein Fachexperte sieh das.
Ich habe in der UF gefiltert, es werden aber immer mehr Daten angezeigt obwohl
nur ein Datensatz vorhanden ist.
Ich habe die Makros aus dem Netz zusammengesucht, teste schon seit 2h.
Es sind 14 Spalten und ab Zeile 3 sind die Daten vorhanden also Zeile 2
sind die Überschriften.

Private Sub UserForm_Activate()
Dim lLetzte  As Long
Dim hwndForm  As Long
Dim hwndMenu  As Long
Dim intY      As Integer
Dim intLast   As Integer
Dim intNext   As Integer
Dim UserForm
Call Array_fuellen
With ListBox1        ' betrifft die ListBox1
' .Height = 62      ' die Höhe festlegen
' .Left = 20        ' den linken Randabstand festlegen
' .Top = 12         ' den oberen Randabstand festlegen
' .Width = 460      ' die Breite festlegen
.Font.Size = 9   ' die Schriftgröße festlegen
.ForeColor = RGB(0, 0, 255) ' Schriftfarbe immer mit RGB
.ColumnCount = 14  ' die Anzahl der Spalten festlegen
' die Breite der Spalten festlegen
.ColumnWidths = _
("0,7 cm;1,5 cm;2 cm;4 cm;3,5 cm;2,5 cm;1 cm;1,5 cm;1,3 cm;1,5 cm;1,2 cm;3,5 cm;3 cm;1cm") _
.Clear            ' die ListBox leeren          mzpqm   nkp    plz    ort   str   nr.
.Column = aTmp
End With
Label111.Caption = Label111.Caption
TextBox7.Value = Format(TextBox7.Value, "0.0")
TextBox8.Value = Format(TextBox8.Value, "#,##0.00")
TextBox9.Value = Format(TextBox9.Value, "0.00")
Label110.Caption = Format(Label110.Caption, "0.00")
TextBox10.Value = Format(TextBox10.Value, "#,##0.00")
With ActiveSheet
lLetzte = IIf(.Range("A65536")  "", 65536, .Range("A65536").End(xlUp).Row)
If lLetzte

Public Sub Array_fuellen()
Dim lLetzte   As Long     ' letzte belegte Zeile in Spalte A
Dim lZeile    As Long     ' For/Next Zeilen-Zähler
Dim lIndex    As Long     ' der Zeilen-Index im Array
Dim iSpalte   As Integer  ' der Spalten-Index im Array
With ActiveSheet
lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
For lZeile = 3 To lLetzte    'war 2
'If Not IsEmpty(Cells(lZeile, 8)) Then ' Spalte H nicht leer?
lIndex = lIndex + 1
ReDim Preserve aTmp(1 To 15, 1 To lIndex)   'war 8
For iSpalte = 1 To 14       'war 7
aTmp(iSpalte, lIndex) = Cells(lZeile, iSpalte).Text
aTmp(15, lIndex) = lZeile   'war 8
Next iSpalte
'End If
Next lZeile
End With
End Sub

Public Sub CommandButton16_Click()
'- erst alles wieder einblenden------
'  ActiveSheet.Range("A2:n65000").EntireRow.Hidden = False
' ActiveSheet.Range("A2:N2").Select
' Selection.AutoFilter
ActiveSheet.Range("B2").Select
ActiveSheet.Range("$A$2:$N$65000").AutoFilter Field:=2, Criteria1:="Ac2"
Call UserForm_ActivateEnd Sub

mfg
walter ph

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Walter,
nur wenige schauen auf Deinen Rechner und sehen die Datei.
Ich möchte gerne den Fehler im Original sehen.
Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.
Ein Nachbau sieht meist anders aus als das Original. Darum sollte das Original verlinkt werden.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten anonymisieren bzw. pseudonymisieren.
man könnte vermuten Du prüfst nicht die Zeilenhöhe beim füllen.

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben, mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.

Public Sub Array_fuellen() Dim lLetzte As Long ' letzte belegte Zeile in Spalte A Dim lZeile As Long ' For/Next Zeilen-Zähler Dim lIndex As Long ' der Zeilen-Index im Array Dim iSpalte As Integer ' der Spalten-Index im Array With ActiveSheet lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row For lZeile = 3 To lLetzte 'war 2 'If Not IsEmpty(Cells(lZeile, 8)) Then ' Spalte H nicht leer? lIndex = lIndex + 1 ReDim Preserve aTmp(1 To 15, 1 To lIndex) 'war 8 For iSpalte = 1 To 14 'war 7 If Rows(lZeile).EntireRow.Hidden = False Then aTmp(iSpalte, lIndex) = Cells(lZeile, iSpalte).Text aTmp(15, lIndex) = lZeile 'war 8 End If Next iSpalte 'End If Next lZeile End With End Sub

Public Sub Array_fuellen() Dim lLetzte As Long ' letzte belegte Zeile in Spalte A Dim lZeile As Long ' For/Next Zeilen-Zähler Dim lIndex As Long ' der Zeilen-Index im Array Dim iSpalte As Integer ' der Spalten-Index im Array Dim raBereich As Range Dim raZelle As Range With ActiveSheet lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row Set raBereich = .Range(.Cells(3, 1), .Cells(lLetzte, 1)) For lZeile = 3 To lLetzte 'war 2 'If Not IsEmpty(Cells(lZeile, 8)) Then ' Spalte H nicht leer? lIndex = lIndex + 1 ReDim Preserve aTmp(1 To 15, 1 To lIndex) 'war 8 For iSpalte = 1 To 14 'war 7 If .Cells(lZeile, iSpalte).EntireRow.Hidden = False Then aTmp(iSpalte, lIndex) = Cells(lZeile, iSpalte).Text aTmp(15, lIndex) = lZeile 'war 8 End If Next iSpalte 'End If Next lZeile End With End Sub

Public Sub CommandButton16_Click() Dim s As String Dim Found As Range Dim FirstAddress As String Dim lngRow As Long, lngColumn As Long, lngFoundRow As Long Dim avntValues() s = "ac2" ListBox1.Clear With Sheets("Filtern") Set Found = .Columns(2).Find(what:=s, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:= _ False) If Not Found Is Nothing Then FirstAddress = Found.Address Do lngFoundRow = Found.Row ReDim Preserve avntValues(1 To 15, 0 To lngRow) For lngColumn = 1 To 15 avntValues(lngColumn, lngRow) = .Cells(lngFoundRow, lngColumn).Value Next Set Found = .Columns(2).FindNext(after:=Found) If Found.Address = FirstAddress Then Exit Do lngRow = lngRow + 1 Loop ListBox1.Column = avntValues End If End With End Sub

Beliebteste Forumthreads (12 Monate)

Listbox zeigt bei gefilterte Daten...

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Listbox zeigt bei gefilterte Daten...

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread