Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1688to1692
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
listobject - DataBodyRange Problem
24.04.2019 20:22:17
Georg
Hallo zusammen,
ich habe da ein Problem, bei dem ich etwas Hilfe brauche.
Ich habe ein sheet("Mitglieder") und ein listobject "Mitgliederliste".
Bisher brauchte ich immer nur die gesamte Anzahl der vorhandenen Zeilen im listobject. Dies funktioniert auch einwandfrei.
Nun habe ich aber einen Filter eingebaut:
Sheets("Mitglieder").ListObjects("Mitgliederliste").Range.AutoFilter Field:=8, Criteria1:=Kurs
und bekomme es einfach nicht hin, dass die ausgeblendeten Zeilen beim Datenexport:
Nummer = tbl.DataBodyRange(varZeile + n, varNummer)

irgnoriert werden.
Ich weiß zwar, dass es irgendwie mit SpecialCells(xlCellTypeVisible) funktionieren muss, bekomme es aber einfach nicht hin.
Ich hoffe ich konnte mein Problem relativ deutlich darstellen. Falls nicht, könnte ich eine Beispieldatei zusammenbauen.
Ich bin für jeden Tipp dankbar!
Liebe Grüße

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: listobject - DataBodyRange Problem
25.04.2019 05:40:47
Hajo_Zi
mache eine schleife und weise mit Additem nur die suchtbaren zu.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
AW: listobject - DataBodyRange Problem
25.04.2019 07:16:32
Luschi
Hallo Georg,
hier mal mein Versuch:

Sub gefiltertKurs()
Dim lstObj As ListObject, rgFilter As Range
Set lstObj = ThisWorkbook.Worksheets("Tabelle1").ListObjects("tbl_Teilnehmer")
With lstObj
If .DataBodyRange.Rows.Count > _
.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows.Count Then
Set rgFilter = lstObj.DataBodyRange.SpecialCells(xlCellTypeVisible)
rgFilter.Copy
ThisWorkbook.Worksheets("Tabelle2").Range("A5"). _
PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Else
MsgBox "nix kopiert, da kein Filter gesetzt!", vbMsgBoxSetForeground, _
"Hinweis..."
End If
End With
Set rgFilter = Nothing
Set lstObj = Nothing
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: listobject - DataBodyRange Problem
25.04.2019 20:12:39
Georg
Danke für die Mühe.
@Luschi
Bei deinem Vorschlag werden ja die aktuell sichtbaren Zeilen aus der Tabelle kopiert und wo anders wieder eingefügt. Dies ist leider nicht ganz das was ich gesucht habe.
Die Funktionsweise meiner Sub:
Ich erstelle aktuell anhand der Anzahl (im Moment ja alle) von Zeilen im Listobject("Mitgliederliste") jeweils eine Textbox. In diese Textbox wird dann der Text von bestimmten Spalten geschrieben.
Diese Schleife läuft so lange bis das Ende der Objectlist erreicht wurde.
Nun möchte ich aber auch einen Filter setzen und dann natürlich nur noch die Anzahl an Textboxen erstellen, die der sichtbaren Einträge entspricht.
 Sub status_pruefen(Optional Kurs As String = "alle")
'Variablen setzen
Dim plTop As Integer, plHeight As Integer, plWidth As Integer, plLeft As Integer
Dim ufHeigth As Integer, ufWidth As Integer
Dim hSpace As Integer, vSpace As Integer
Dim i As Integer, n As Integer
Dim MyCtrl As Control
Dim txtBox1 As Integer, txtBox2 As Integer
Dim varSpalte As Integer
Dim varZeile As Integer
Dim varName As Integer
Dim varVorname As Integer
Dim varKundennummer As Integer
Dim varOrt As Integer
Dim varKurs As Integer
'Userform erstellen
vSpace = 5
hSpace = 5
plTop = 5
plWidth = 50
plHeight = 20
plLeft = 10
'Kurs = "Tango"
Set wb = ThisWorkbook 'Variable/Abkürzung für diese Excel Datei
'Hier wird das worksheet festgelegt. Die Variable "Hersteller" wird in dem Hauptprogramm  _
vergeben.
Set ws = Worksheets("Mitglieder")
With wb
'Suchen in dem Sheet (ausgewählter Hersteller) in einer bestimmten Tabelle
Set tbl = ws.ListObjects("Mitgliederliste")
' Die Spalte "Status" wird gesucht
varSpalte = Application.Match("Status", tbl.HeaderRowRange, 0)
'Finden der Spalte "Name"
varName = Application.Match("Name", tbl.HeaderRowRange, 0)
'Finden der Spalte "Vorname"
varVorname = Application.Match("Vorname", tbl.HeaderRowRange, 0)
'Finden der Spalte "Kundennummer"
varKundennummer = Application.Match("Kundennummer", tbl.HeaderRowRange, 0)
'Finden der Spalte "Wohnort"
varOrt = Application.Match("Ort", tbl.HeaderRowRange, 0)
'Finden der Spalte "Kurs"
varKurs = Application.Match("Kurs", tbl.HeaderRowRange, 0)
' Der Anfang wird ab zeile 1 gesetzt
varZeile = 0
'Anzahl der vorhandenen Mitglieder ermitteln
txtBox1 = Mitglieder(Kurs)
'Nur eine Reihe von Textboxen erzeugen.
txtBox2 = txtBox1
ufHeigth = 400
ufWidth = 300
'Die Größe vom neuen Userform wird festgelegt
Debug.Print "Höhe: " & ufHeigth
Status.Height = ufHeigth
Status.Width = ufWidth
For i = 1 To (txtBox1 / txtBox2)
For n = 1 To txtBox2
' Erstellen von Togglebuttons, um den Status der Benutzer dar zu stellen
' Rot = offline
' Grün = online
'       Set MyCtrl = Status.Controls.Add("Forms.textbox.1")
'Erstellen vom Tooglebutton
Set MyCtrl = Status.Controls.Add("Forms.ToggleButton.1")
MyCtrl.Left = plLeft
MyCtrl.Top = plTop
MyCtrl.Width = 20 'plWidth / 3
MyCtrl.Height = plHeight
MyCtrl.Name = "ToggleButton" & i
'Einfärben der Buttons um den Status visuell sichtbar zu machen
If tbl.DataBodyRange(varZeile + n, varSpalte) = "T" Then 'Wenn das Mitglied offline ist: _
With MyCtrl
.BackColor = RGB(255, 0, 0) 'rot
.Value = True
'       .BackColor = RGB(25, 210, 75) 'grün
.Caption = ""
.TextAlign = fmTextAlignCenter
.Font.Size = 20
.BackStyle = fmBackStyleOpaque
.Locked = True
End With
ElseIf tbl.DataBodyRange(varZeile + n, varSpalte) = "R" Then 'Wenn das Mitglied offline  _
ist:
With MyCtrl
.Value = False
'       .BackColor = RGB(255, 0, 0) 'rot
.BackColor = RGB(25, 210, 75) 'grün
.Caption = ""
.TextAlign = fmTextAlignCenter
.Font.Size = 20
.BackStyle = fmBackStyleOpaque
.Locked = True
End With
End If
'Erstellen von einer Textbox
Set MyCtrl = Status.Controls.Add("Forms.Textbox.1")
MyCtrl.Left = plLeft + 30
MyCtrl.Top = plTop
MyCtrl.Width = plWidth * 4.5
MyCtrl.Height = plHeight
MyCtrl.Name = "Textbox" & i
plTop = plTop + plHeight + 5
Dim objCell As Range
For Each objCell In tbl.DataBodyRange.SpecialCells(Type:=xlCellTypeVisible)
'        Call MsgBox(objCell.Value)
Next
Name = tbl.DataBodyRange(varZeile + n, varName)
Vorname = tbl.DataBodyRange(varZeile + n, varVorname)
Ort = tbl.DataBodyRange(varZeile + n, varOrt)
kundennummer = tbl.DataBodyRange(varZeile + n, varKundennummer)
MyCtrl.Value = Name & " " & Vorname & ", " & Ort & ", " & kundennummer
Next n
plTop = 5
plLeft = plLeft + plWidth + hSpace
Next i
Status.ScrollHeight = MyCtrl.Top
End With
End Sub
Möglicherweise wird mein Problem so besser sichtbar.
Ich danke für jeden Rat!
Liebe Grüße
Anzeige
AW: listobject - DataBodyRange Problem
25.04.2019 23:41:50
Mullit
Hallo,
mach mal so:
Public Sub testauszug()
  Dim objRow As Range, objCell As Range
  Dim lngIndex As Long
  Dim strName As String, strVorname As String '// denk dran, Deine Vars alle(!) zu dekl. >>> 
  Dim strOrt As String, strKundennummer As String '// >>> Du verw. doch wohl Opt. Expl. oder nich...;-) 
  With ActiveSheet.ListObjects(1).DataBodyRange.SpecialCells(Type:=xlCellTypeVisible)
      For lngIndex = 1 To .Areas.Count
         For Each objRow In .Areas(lngIndex).Rows
         
            '// Erstellen von einer Textbox 
                Set MyCtrl = Status.Controls.Add( _
                  bstrProgID:="Forms.Textbox.1", Name:="Textbox" & i)
                MyCtrl.Left = plLeft + 30
                MyCtrl.Top = plTop
                MyCtrl.Width = plWidth * 4.5
                MyCtrl.Height = plHeight
                plTop = plTop + plHeight + 5
            For Each objCell In objRow.Cells
                With objCell
                    Select Case .Column
                       Case Is = varName: strName = .Value
                       Case Is = varVorname: strVorname = .Value
                       Case Is = varOrt: strOrt = .Value
                       Case Is = varKundennummer: strKundennummer = .Value
                    End Select
                End With
            Next
          MyCtrl.Value = strName & " " & strVorname & ", " & strOrt & ", " & strKundennummer
         Next
      Next
  End With
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 14

Gruß, Mullit
Anzeige
AW: listobject - DataBodyRange Problem
26.04.2019 22:38:22
Georg
Vielen Dank für die Anregungen.
@Mullit
Ich habe dein Beispiel mal bei mir eingebaut und angepasst.
Das funktioniert auch soweit ganz gut. Nur wird komischerweise die letzte Zeile in der Tabelle nicht mehr beachtet, sobald da mehrere Einträge vorhanden sind. Bei nur 2 zeilen klappt es wunderbar.
Sobald ich diesen Bug behoben habe, werde ich die Lösung hier nochmal posten.
Vielen Dank nochmal!
AW: listobject - DataBodyRange Problem
27.04.2019 10:24:12
Georg
So jetzt habe ich es nochmal angepasst. Nun funktioniert es wie es soll.
Danke Mullit
 Sub status_pruefen2(Optional Kurs As String = "alle")
'Variablen setzen
Dim plTop As Integer, plHeight As Integer, plWidth As Integer, plLeft As Integer
Dim hSpace As Integer, vSpace As Integer
Dim MyCtrl As Control
Dim MyCtr2 As Control
Dim varSpalte As Integer
Dim varZeile As Integer
Dim varName As Integer
Dim varVorname As Integer
Dim varKundennummer As Integer
Dim varOrt As Integer
Dim varKurs As Integer
Dim varStatus As Integer
Dim objRow As Range, objCell As Range
Dim lngIndex As Long
Dim strName As String, strVorname As String
Dim strOrt As String, strKundennummer As String
Dim strStatus As String
'Userform erstellen
vSpace = 5
hSpace = 5
plTop = 5
plWidth = 50
plHeight = 20
plLeft = 10
'Kurs = "Tango"
Set wb = ThisWorkbook 'Variable/Abkürzung für diese Excel Datei
'Hier wird das worksheet festgelegt. Die Variable "Hersteller" wird in dem Hauptprogramm  _
vergeben.
Set ws = Worksheets("Mitglieder")
With wb
'Suchen in dem Sheet (ausgewählter Hersteller) in einer bestimmten Tabelle
Set tbl = ws.ListObjects("Mitgliederliste")
' Die Spalte "Status" wird gesucht
varSpalte = Application.Match("Status", tbl.HeaderRowRange, 0)
'Finden der Spalte "Name"
varName = Application.Match("Name", tbl.HeaderRowRange, 0)
'Finden der Spalte "Vorname"
varVorname = Application.Match("Vorname", tbl.HeaderRowRange, 0)
'Finden der Spalte "Kundennummer"
varKundennummer = Application.Match("Kundennummer", tbl.HeaderRowRange, 0)
'Finden der Spalte "Wohnort"
varOrt = Application.Match("Ort", tbl.HeaderRowRange, 0)
'Finden der Spalte "Kurs"
varKurs = Application.Match("Kurs", tbl.HeaderRowRange, 0)
varStatus = Application.Match("Status", tbl.HeaderRowRange, 0)
' Der Anfang wird ab zeile 1 gesetzt
varZeile = 0
'Die Größe vom neuen Userform wird festgelegt
Status.Height = 450
Status.Width = 300
With Sheets("Mitglieder").ListObjects(1).DataBodyRange.SpecialCells(Type:= _
xlCellTypeVisible)
For lngIndex = 1 To .Areas.Count
Debug.Print "areas count:"; .Areas.Count
For Each objRow In .Areas(lngIndex).Rows
'Erstellen vom Tooglebutton
Set MyCtr2 = Status.Controls.Add("Forms.ToggleButton.1")
MyCtr2.Left = plLeft
MyCtr2.Top = plTop
MyCtr2.Width = 20 'plWidth / 3
MyCtr2.Height = plHeight
MyCtr2.Name = "ToggleButton" & i
'// Erstellen von einer Textbox
Set MyCtrl = Status.Controls.Add( _
bstrProgID:="Forms.Textbox.1", Name:="Textbox" & i)
MyCtrl.Left = plLeft + 30
MyCtrl.Top = plTop
MyCtrl.Width = plWidth * 4.5
MyCtrl.Height = plHeight
plTop = plTop + plHeight + 5
For Each objCell In objRow.Cells
With objCell
Select Case .Column
Case Is = varName: strName = .Value
Case Is = varVorname: strVorname = .Value
Case Is = varOrt: strOrt = .Value
Case Is = varKundennummer: strKundennummer = .Value
Case Is = varStatus: strStatus = .Value
'Formatieren vom Togglebutton jenach Status
If strStatus = "T" Then 'Wenn das Mitglied offline ist:
With MyCtr2
.BackColor = RGB(255, 0, 0) 'rot
.Value = True
'       .BackColor = RGB(25, 210, 75) 'grün
.Caption = ""
.TextAlign = fmTextAlignCenter
.Font.Size = 20
.BackStyle = fmBackStyleOpaque
.Locked = True
End With
ElseIf strStatus = "R" Then 'Wenn das Mitglied offline ist:
With MyCtr2
.Value = False
'       .BackColor = RGB(255, 0, 0) 'rot
.BackColor = RGB(25, 210, 75) 'grün
.Caption = ""
.TextAlign = fmTextAlignCenter
.Font.Size = 20
.BackStyle = fmBackStyleOpaque
.Locked = True
End With
End If
End Select
End With
Next
MyCtrl.Value = strName & " " & strVorname & ", " & strOrt & ", " & strKundennummer ' _
schreiben der Mitgliedsdaten in die erstellte Textbox
Next
Next
End With
Status.ScrollHeight = MyCtrl.Top + 25 'Länge der Scrollbar festlegen
End With
End Sub

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige