Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1568to1572
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

Bitte Daniel nochmal ! oder auch natürlich...

Bitte Daniel nochmal ! oder auch natürlich...
29.07.2017 18:06:13
philipp
Guten Abend,
Daniel hatte vorgestern geholfen aber leider klappt es nicht.
Es werden die gefilterten Daten doch nicht eingelesen, warum auch immer.
Hier bleibt stehen:
Me.ListBox1.RemoveItem i
Wieder Laufzeitfehler, nicht näher bezeichneter Fehler.
Irgenwie habe ich wohl einen Fehler eingebaut.
Hier beide Makros:
Private Sub UserForm_Activate()
Dim iIndex  As Integer
'--------------- für Bildschirmanpassung --------------------------------------
Dim hwndForm As Long, hwndMenu As Long
Dim intY, intLast, intNext As Integer
On Error Resume Next
With UserForm1
.StartUpPosition = 0
.Top = 0
.Left = 0
.Height = GetDeviceCaps(GetDC(0&), 8)
.Width = GetDeviceCaps(GetDC(0&), 10)
End With
ReleaseDC 0, GetDC(0&)
hwndForm = FindWindow(vbNullString, Me.Caption)
'------------ ab hier festgelegt, UF kann nicht verschoben werden ----------------
'If hwndForm  0 Then
'     hwndMenu = GetSystemMenu(hwndForm, 0)
' If hwndMenu  0 Then DeleteMenu hwndMenu, &HF010, &H0
' End If
Dim sBlattname  As String
sBlattname = ActiveSheet.Name
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")         'mietzins pro monat
Label110.Caption = Format(Label110.Caption, "0.00")
TextBox10.Value = Format(TextBox10.Value, "#,##0.00")
Label8.Caption = "Anzahl der Mietwohnungen:  " & ActiveSheet.Range("D1")
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
Dim LoLetzte2 As Long
Dim lngI As Long
Dim i
' Me.ListBox1.List = Sheets(sBlattname).Range("A3:N" & LoLetzte2).Value     ' neu daniel
' Label8.Caption = "Anzahl der Mietwohnungen:  " & (lLetzte - 2)
If Not ActiveSheet.AutoFilterMode Then
LoLetzte2 = Sheets(sBlattname).Cells(Rows.Count, 1).End(xlUp).Row
Me.ListBox1.RowSource = sBlattname & "!A3:N" & LoLetzte2
ComboBox1.AddItem "Alle anzeigen"
For lngI = 0 To ListBox1.ListCount
ComboBox1.AddItem ListBox1.Column(1, lngI)
Next
' ComboBox1.ListIndex = 0
Label115.Caption = ""
Else
ActiveSheet.Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(2,R3C1:R65000C1)"
Label115.Caption = "gefilterte:  " & ActiveSheet.Range("D1")
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.List(i, 1)  ComboBox1.Text Then ListBox1.RemoveItem i
Next
End If
TextBox2.SetFocus
End Sub
im Makro ComboBox bleibt da stehen:
Me.ListBox1.RemoveItem i
Wieder Laufzeitfehler, nicht näher bezeichneter Fehler.
Private Sub ComboBox1_Change()
Dim LoLetzte2 As Long
Dim LoLetzte1 As Long
Dim i
Dim lngI As Long
Dim sBlattname  As String
sBlattname = ActiveSheet.Name
CommandButton2.Enabled = False  ' den Änder-Button sperren
CommandButton3.Enabled = False  ' den Änder-Button sperren
CommandButton4.Enabled = False  ' den Lösch-Button sperren
ActiveSheet.Range("$A$2:$N$2").AutoFilter Field:=2, Criteria1:=ComboBox1.Text
'"*", VisibleDropDown:=False
'ListBox1.List = ActiveSheet.Range("A3:N200").Value ' neu daniel
For i = ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.List(i, 1)  ComboBox1.Text Then Me.ListBox1.RemoveItem i
Next
If ComboBox1.ListIndex = 0 Then
ActiveSheet.Range("$A$2:$N$2").AutoFilter Field:=2
If ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
Call UserForm_Activate
End If
If ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(2,R3C1:R65000C1)"
Label115.Caption = "gefilterte:  " & ActiveSheet.Range("D1")
Else
Label115.Caption = ""
CommandButton2.Enabled = True
CommandButton3.Enabled = True
CommandButton4.Enabled = True
End If
End Sub
gruß
philipp b

29
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Hat den keiner einen Tip ?
30.07.2017 11:22:35
philipp
Guten Morgen zusammen,
ich habe heute Morgen schon wieder 2h damit verbracht eine Lösung
zu finden, leider ohne Erfolg.
Vielleicht hat doch jemand eine Lösung,
gruß
phlipp b
Habe was im Forum gefunden von Sepp...
30.07.2017 12:24:34
Sepp...
Hallo,
ich habe nochmal gestöbert und was von Josef Ehrensberger (Sepp) vom 17.1.2009 gefunden.
Leider klappt es nur bis 10 Spalten.
With ActiveSheet
lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
For lZeile = 3 To lLetzte
If .Cells(lZeile, 1) = "" Then Exit For
If .Rows(lZeile).Hidden = False Then
ListBox1.AddItem
ListBox1.List(lLibox, 0) = .Cells(lZeile, 1).Value
ListBox1.List(lLibox, 1) = .Cells(lZeile, 2).Value
ListBox1.List(lLibox, 2) = .Cells(lZeile, 3).Value
ListBox1.List(lLibox, 3) = .Cells(lZeile, 4).Value
ListBox1.List(lLibox, 4) = .Cells(lZeile, 5).Value
ListBox1.List(lLibox, 5) = .Cells(lZeile, 6).Value
ListBox1.List(lLibox, 6) = .Cells(lZeile, 7).Value
ListBox1.List(lLibox, 7) = .Cells(lZeile, 8).Value
ListBox1.List(lLibox, 8) = .Cells(lZeile, 9).Value
ListBox1.List(lLibox, 9) = .Cells(lZeile, 10).Value
ListBox1.List(lLibox, 10) = .Cells(lZeile, 11).Value
ListBox1.List(lLibox, 11) = .Cells(lZeile, 12).Value
ListBox1.List(lLibox, 12) = .Cells(lZeile, 13).Value
ListBox1.List(lLibox, 13) = .Cells(lZeile, 14).Value
lLibox = lLibox + 1
End If
Next
End With
gruß
philipp b
Anzeige
AW: Hat den keiner einen Tip ?
30.07.2017 12:36:54
Matthias
Moin! Also meiner Meinung nach geht in deinem Fall das RemoveItem nicht. So wie ich das sehe, liest du ja die Daten mit RowSource ein. Da ist die Listbox mit den Daten direkt verknüpft. Wenn du was aus der Listbox löschen willst, musst die in der Quelle was löschen - also deine Daten entfernen. Das ist aber wohl nicht so gewollt. Gibt jetzt mehrere Optionen.
1. Die Daten nicht mit RowSource sondern Additem einlesen - geht aber nur für 10 Spalten.
2. Ein Tabellenblatt (oder Bereich in dem Blatt) temporär mit den Quelldaten beschreiben (so muss man nicht die Originaldaten löschen). In diesen TempDaten dann löschen (was dem Entfernen aus der Listbox entsprechen würde) und beim schließen der UF das TempBlatt wieder löschen.
Vllt. hat ja noch jemand eine andere Lösung. VG
Anzeige
Danke Matthias aber ich habe die ...
30.07.2017 12:48:27
philipp
Hallo Matthias,
danke für deine Information.
Ich habe allerdings die Nr. 2 nicht verstanden, gibts da ein Beispiel ?
nit diesem Makro geht es ja bis Spalte 10 !
With ActiveSheet
lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
For lZeile = 3 To lLetzte
If .Cells(lZeile, 1) = "" Then Exit For
If .Rows(lZeile).Hidden = False Then
ListBox1.AddItem
ListBox1.List(lLibox, 0) = .Cells(lZeile, 1).Value
ListBox1.List(lLibox, 1) = .Cells(lZeile, 2).Value
ListBox1.List(lLibox, 2) = .Cells(lZeile, 3).Value
ListBox1.List(lLibox, 3) = .Cells(lZeile, 4).Value
ListBox1.List(lLibox, 4) = .Cells(lZeile, 5).Value
ListBox1.List(lLibox, 5) = .Cells(lZeile, 6).Value
ListBox1.List(lLibox, 6) = .Cells(lZeile, 7).Value
ListBox1.List(lLibox, 7) = .Cells(lZeile, 8).Value
ListBox1.List(lLibox, 8) = .Cells(lZeile, 9).Value
ListBox1.List(lLibox, 9) = .Cells(lZeile, 10).Value
ListBox1.List(lLibox, 10) = .Cells(lZeile, 11).Value
ListBox1.List(lLibox, 11) = .Cells(lZeile, 12).Value
ListBox1.List(lLibox, 12) = .Cells(lZeile, 13).Value
ListBox1.List(lLibox, 13) = .Cells(lZeile, 14).Value
lLibox = lLibox + 1
End If
Next
End With
gruß
philipp b
Anzeige
Wird eingelesen aber,Soll ich Muster anfertigen ?
30.07.2017 13:22:00
philipp
Hallo zusammen,
Private Sub ComboBox1_Change()
Dim LoLetzte2 As Long
Dim LoLetzte1 As Long
Dim i
Dim lngI As Long
Dim sBlattname  As String
sBlattname = ActiveSheet.Name
ActiveSheet.Range("$A$2:$N$2").AutoFilter Field:=2, Criteria1:=ComboBox1.Text
If ComboBox1.ListIndex = 0 Then
ActiveSheet.Range("$A$2:$N$2").AutoFilter Field:=2
End If
Call UserForm_Activate
End Sub
So werden die Daten einlesen aber die darüber befindlichen Zeilen auch, ab Zeile 4 sind
die gefilterten Daten.
Es werden die 4 Zeilen darüber auch angezeigt.
Das in Userform:
LoLetzte2 = Sheets(sBlattname).Cells(Rows.Count, 1).End(xlUp).Row
Me.ListBox1.RowSource = sBlattname & "!A3:N" & LoLetzte2
ComboBox1.AddItem "Alle anzeigen"
For lngI = 0 To ListBox1.ListCount
ComboBox1.AddItem ListBox1.Column(1, lngI) ' 1 = Spalte B
Next
' ComboBox1.ListIndex = 0
Exit Sub
gruß
philipp b
Anzeige
AW: Wird eingelesen aber,Soll ich Muster anfertigen ?
30.07.2017 13:36:55
Matthias
HAllo! Nochmal zum Verständnis. Du liest alle Daten ein und willst die dann filtern? Bisher (Code im ersten Beitrag hier) werden alle eingetragen, auch die, welche eigentlich raus sollten? Beim Filtern de Daten tritt de Fehler auf. Wenn du fehlerhafte Zeile (mit dem RemoveItem) rausnimmst, stehen also zuviele Daten drin. Jetzt fehlt also die Schleife, die dir die falschen Zeilen rauslöscht? Kommt das so hin?
Zu den Varianten. Bei der 2ten würde man ein Blatt anlegen, dorthin nochmal die Daten kopieren und das als Ausgangspunkt für die RowSource nehmen. Dort kannst du dann löschen und so die Anzeige in der Listbox verändern.
Hätte aber noch eine dritte Variante, grad getestet. Bevor ich jetzt aber falsch liege nochmal die Frage.
VG
Anzeige
Hier Antwort
30.07.2017 13:59:40
philipp
Hallo Matthias,
grundsätzlich möchte ich die UF starten und es sollen auch da die gefilterten
Daten angezeigt werden.
Wenn nicht möglich egal ...
Dann UF alle Daten einlesen und mit der CombiBox1 filtern und dann die
Daten einlesen.
gruß
philipp b
AW: Hier Antwort
30.07.2017 15:27:31
Matthias
Hallo! Habe jetzt mal in deinem Anfangscode das Removeitem ersetzt. Damit ersetze ich deine Listbox mit gefilterten Werten in einer kleine Sub. Am Rest vom Code habe ich erstmal nichts geändert. Probiere es mal aus. VG

Private Sub UserForm_Activate()
Dim iIndex  As Integer
'--------------- für Bildschirmanpassung --------------------------------------
Dim hwndForm As Long, hwndMenu As Long
Dim intY, intLast, intNext As Integer
On Error Resume Next
With UserForm1
.StartUpPosition = 0
.Top = 0
.Left = 0
.Height = GetDeviceCaps(GetDC(0&), 8)
.Width = GetDeviceCaps(GetDC(0&), 10)
End With
ReleaseDC 0, GetDC(0&)
hwndForm = FindWindow(vbNullString, Me.Caption)
'------------ ab hier festgelegt, UF kann nicht verschoben werden ----------------
'If hwndForm  0 Then
'     hwndMenu = GetSystemMenu(hwndForm, 0)
' If hwndMenu  0 Then DeleteMenu hwndMenu, &HF010, &H0
' End If
Dim sBlattname  As String
sBlattname = ActiveSheet.Name
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")         'mietzins pro monat
Label110.Caption = Format(Label110.Caption, "0.00")
TextBox10.Value = Format(TextBox10.Value, "#,##0.00")
Label8.Caption = "Anzahl der Mietwohnungen:  " & ActiveSheet.Range("D1")
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
Dim LoLetzte2 As Long
Dim lngI As Long
Dim i
' Me.ListBox1.List = Sheets(sBlattname).Range("A3:N" & LoLetzte2).Value     ' neu daniel
' Label8.Caption = "Anzahl der Mietwohnungen:  " & (lLetzte - 2)
If Not ActiveSheet.AutoFilterMode Then
LoLetzte2 = Sheets(sBlattname).Cells(Rows.Count, 1).End(xlUp).Row
Me.ListBox1.RowSource = sBlattname & "!A3:N" & LoLetzte2
ComboBox1.AddItem "Alle anzeigen"
For lngI = 0 To ListBox1.ListCount
ComboBox1.AddItem ListBox1.Column(1, lngI)
Next
' ComboBox1.ListIndex = 0
Label115.Caption = ""
Else
ActiveSheet.Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(2,R3C1:R65000C1)"
Label115.Caption = "gefilterte:  " & ActiveSheet.Range("D1")
Call zeile_löschen2(Me.ListBox1, Me.ComboBox1.Text)
End If
TextBox2.SetFocus
End Sub
Private Sub ComboBox1_Change()
Dim LoLetzte2 As Long
Dim LoLetzte1 As Long
Dim i
Dim lngI As Long
Dim sBlattname  As String
sBlattname = ActiveSheet.Name
CommandButton2.Enabled = False  ' den Änder-Button sperren
CommandButton3.Enabled = False  ' den Änder-Button sperren
CommandButton4.Enabled = False  ' den Lösch-Button sperren
ActiveSheet.Range("$A$2:$N$2").AutoFilter Field:=2, Criteria1:=ComboBox1.Text
'"*", VisibleDropDown:=False
'ListBox1.List = ActiveSheet.Range("A3:N200").Value ' neu daniel
Call zeile_löschen2(Me.ListBox1, Me.ComboBox1.Text)
If ComboBox1.ListIndex = 0 Then
ActiveSheet.Range("$A$2:$N$2").AutoFilter Field:=2
If ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
Call UserForm_Activate
End If
If ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(2,R3C1:R65000C1)"
Label115.Caption = "gefilterte:  " & ActiveSheet.Range("D1")
Else
Label115.Caption = ""
CommandButton2.Enabled = True
CommandButton3.Enabled = True
CommandButton4.Enabled = True
End If
End Sub
Sub zeile_löschen2(liste As Object, suchwert As String)
Dim zeilealte As Long
Dim zeile As Long
Dim spalte As Long
Dim anzahl As Long
Dim neu
Dim temp
neu = liste.List
zeilealte = 0
anzahl = 0
For i = 0 To UBound(neu, 1)
If neu(i, 0) = suchwert Then anzahl = anzahl + 1
Next i
if anzahl = 0 then
liste.RowSource = ""
exit sub
end if
ReDim temp(anzahl - 1, UBound(neu, 2))
For zeile = 0 To anzahl - 1
While neu(zeilealte, 0)  suchwert
zeilealte = zeilealte + 1
Wend
For spalte = 0 To UBound(temp, 2)
temp(zeile, spalte) = neu(zeilealte, spalte)
Next spalte
zeilealte = zeilealte + 1
Next zeile
liste.RowSource = ""
liste.List = temp
End Sub

Anzeige
Schade, leider klappt es nicht Matthias
30.07.2017 16:02:03
philipp
Hallo Matthias,
habe dein Muster der UF,
Sub zeile_löschen2(liste As Object, suchwert As String) und
Private Sub ComboBox1_Change()
übernommen.
Ich kann auswählen die Werte werden auch in der Tabelle angezeigt aber
die gefilterten nicht in der ListBox.
gruß
philipp b
AW: Schade, leider klappt es nicht Matthias
30.07.2017 16:04:56
Matthias
Hallo! Kannst du ggf. mal die Mappe hochladen? VG
Ich lade Mustermappe..
30.07.2017 16:26:15
philipp
AW: Ich lade Mustermappe..
30.07.2017 16:41:02
Matthias
Ok aber die folgt dann noch? Hier war zumindest der Link dazu nicht dabei. VG
AW: Hier die Musterdatei
30.07.2017 18:07:17
Matthias
Hallo! Hier nochmal zurück. Musste sie in xls umwandeln. Deshalb am besten nur mal damit testen und den Code übernehmen - kann sein, dass durch die Formatänderungen Verlinkungen, Aufbau etc. verändert wurden.
Also habe ein wenig im Code geändert. Was mir persönlich nicht gefällt ist, das beim Change der Combo immer das Activate aufgerufen wird. Das hätte ich anders gelöst (fehlt mir aber grad an Zeit). Wo manchmal noch Fehler auftraten, war bei dem Autofilter. Da kam plötzlich, dass er nicht drauf zu greifen kann. WEiß nicht, ob das bei dir auch so ist. Da die Listbox1 gefiltert angezeigt wird, wäre die Frage, ob du den überhaupt noch brauchst. Dann ggf. auskommentieren.
geändert habe ich wie folgt im Code der Useform:
- allgemein Variablen angelegt
- Activate Ereignis ergänzt
- AUsgangsliste für die Listbox zwischengespeichert
- dort erfolgt der Aufruf des Listenfilters
- den Aufbau der Combox bereinigt (jedes Element nur einmal)
- ComboBoxChange ergänzt
- das Listboxfilter Makro integriert (war die falsche Spalte die überprüft wurde)
- beim Entragen CommandBox1 was ergänzt, da war noch ein Fehler drin (die letzte SChleife hat ab Textbox1 geleert, geht aber erst ab Textbox2 los). Außerdem wird da bei Bedarf die Combobox um einen Wert ergänzt.
Teste mal die Datei und wenn es passt, übernimm den Code in dein Project.
UNd wie gesagt beim Autofilter mal schauen, ob du den noch brauchst.
VG
https://www.herber.de/bbs/user/115137.xls
Anzeige
Perfekt Matthias
30.07.2017 18:52:53
philipp
Hallo Matthias,
bei mir funktioniert es einwandfrei.
DANKE !
Wenn ich in der Tabelle filtere aund dann die UF aufrufe, werden die darüberliegenden
Zeilen ebenfalls angezeigt, ist egal da ich von der UF aus das Filtern starte.
Die Spalte werden die Zahlen 4 hinter Komma angezeigt !
gruß
philipp b
AW: Perfekt Matthias
30.07.2017 19:04:01
Matthias
Hallo! Schau dir aber mal bitte die Version von fcs noch an. Er hat da ein wenig mehr Zeit investiert und da sollte es ggf. auch runder laufen (bspw. beim Filter). Hätte zugegebenermaßen auch einiges mehr geändert aber das schaffe ich heute nicht und bin die nächste Woche Internetfrei.
Hattest du jetzt noch Fragen? Bei dem Satz hier kam ich nämlich nicht mit.
Die Spalte werden die Zahlen 4 hinter Komma angezeigt !
Ansonsten schönen Abend noch. VG
Anzeige
AW: Perfekt Matthias
30.07.2017 19:26:11
philipp
Hallo Matthias,
läuft alles.
Nur die € Beträge aus der Spalte i werden hinterm Komma 4 stellen angezeigt.
Die anderen Spalten wo Beträge drin stehen werden allerdings nicht mit Komma
und Nullen angezeigt.
Ansonsten schöne Woche..
gruß
philipp b
AW: Perfekt Matthias
30.07.2017 19:31:40
Matthias
Hallo nochmal! Weiß jetzt, was du meinst. Das liegt aber wie Hajo schonmal schrieb an den Rohdaten. Dort hast du eine Division. Das Zellformat beinflusst dabei nicht das Ergebnis sondern nur die Darstellung.
Ändere die Formel in Spalte I mal so um:
=WENN(H3="";"";RUNDEN(+H3/G3;2))
Damit wird das Ergebnis gleich auf 2 Stellen gerundet und nicht nur so dargestellt.
Das hilft bei Spalte I. Ist es bei den anderen egal oder soll dort auch immer 2 Nachkommestellen drin sein - auch wenn die 0 sind?
VG
Auch dieser Tip einwandfrei !!!
30.07.2017 19:54:33
philipp
Hallo Matthias,
ja bei den anderen sollen auch nur immer 500,00 so angezeigt werden, da sind keine Formeln
drin !
gruß
philipp b
AW: Auch dieser Tip einwandfrei !!!
30.07.2017 20:02:21
Matthias
Hallo! Dann formatiere die anderen Spalten mal als Text. Damit siehst du, wie es angezeigt wird. Dort einfach (ist am Anfang mal Arbeit) die ,00 anfügen wo sie fehlen. Damit brauchst du nicht extra die Listbox durchgehen und dort die Werte ändern. Dann passt dort auch die Anzeige. Die Textxboxen geben eh einen String zurück, so dass du beim neuen Erfassen von Einträgen keine Probleme hast (in den Textboxen in der Maske gleich mit ,00 eintragen oder vom Code abfangen lassen).
So muss nun erstmal Schluß machen.
VG
Danke ! mal sehen ob sich Franz meldet
30.07.2017 20:15:24
philipp
Danke Matthias,
auch einwandfrei !
gruß
philipp b
AW: Perfekt Matthias
30.07.2017 19:28:21
Matthias
Hallo nochmal! Weiß jetzt, was du meinst. Das liegt aber wie Hajo schonmal schrieb an den Rohdaten. Dort hast du eine Division. Das Zellformat beinflusst dabei nicht das Ergebnis sondern nur die Darstellung.
Ändere die Formel in Spalte I mal so um:
=WENN(H3="";"";RUNDEN(+H3/G3;2))
Damit wird das Ergebnis gleich auf 2 Stellen gerundet und nicht nur so dargestellt.
VG
AW: Hier die Musterdatei
30.07.2017 18:12:47
fcs
Hallo Philipp,
ich hatte mich jetzt auch schon länger mit deinem Problem beschäfftigt.
Hier mein Vorschlag.
Die Verwaltung der Auswahllisten für die Listbox1 und die Combobox1 erfolgt über Datenarrays innerhalb des Userform-Codes.
Dein aTmp und die Prozedur zum Füllen im allgemeinen Modul hab ich rausgenommen.
Im Userform-Code gibt es jetzt zusätzlich 3 Prozeduren um:
- alle Daten inkl. der Zeilennummer aus dem Tabellenblatt in ein Datenarray einzulesen.
- alle Datensätze in den den Auswahllisten anzuzeigen
- die gefilterten Datensätze anzuzeigen.
Diese 3 Prozeduren werden jetzt an den erforderlichen Stellen aufgerufen. Insbesondere auch dort wo du bisher Userform_Activate aufgerufen hast.
Ich hoffe dein Userform funktioniert jetzt in der gewünschten Form.
Geänderte Einzelzeilen oder Makros hab ich gekenneichnet mit "fcs 2017-07-30"
LG
Franz
https://www.herber.de/bbs/user/115138.xlsm
Hallo Franz, auch peferfekt !
30.07.2017 19:08:28
philipp
Hallo Franz,
erst mal auch Danke für die Unterstützung.
Auch bei Dir ist das Zahlenformat nicht richtig, kann man dies hinkriegen ?
gruß
philipp b
Funktioniert aber
30.07.2017 19:38:10
philipp
Hallo Franz,
einwandfrei alles, so wie es auch Matthias bestätigt hat !!!
Mir ist gerade aufgefallen, bei der Combobox - Auswahl werden die Werte je 1x angezeigt.
(Wie bei Matthias)
Und die Sch... Zahlenformatdarstellung, würde
mich freuen wenn Du das noch ändern könntest !?
gruß
philipp b
Hallo Franz, bitte eine Nachfrage
30.07.2017 21:13:24
philipp
Hallo Franz,
Du hast ja alles überarbeitet, tausend Dank.
Formatierung ist jetzt auch i.o. .
Wenn ich die Combobox z.b. mg1 auswähle, erscheinen 4 in der UF Listbox.
Wenn die UF schließe, sind in der Tabelle aber die mg1 alle 5 vorhanden.
Kann man dies irgendwie anpassen, ändern.
Danke im Voraus,
gruß
philipp b
AW: Hallo Franz, bitte eine Nachfrage
31.07.2017 08:20:49
fcs
Hallo Philipp,
bei meinen Test stimmt die Anzahl der in der UF-Listbox angezeigten Einträge mit der Anzahl der Einträge im Tabellenblatt überein.
Ich hab die Makros zur Anzeige der Auswahllisten nochmals berarbeitet.
In der Combobox wird jetzt jeder Haus-Code nur noch 1 mal angezeigt.
Dazu müsstest du die beidenfolgenden Makros austauschen.
LG
Franz
Sub prcGetAllData()                                             'geändert  fcs 2017-07-31
'Alle Daten inListbox anzeigen und Combobox-Auswahlliste zurücksetzen
Dim wksData As Worksheet
Dim lngZeile As Long
Dim objCol As New Collection
Dim aTmp() As String
Set wksData = Worksheets(sBlattname)
On Error GoTo Fehler
Me.ListBox1.Clear
Me.ComboBox1.Clear
With wksData
Me.ListBox1.List = arrData
objCol.Add "Alle anzeigen", "Alle anzeigen"
For lngZeile = 1 To UBound(arrData, 1)
If arrData(lngZeile, 2)  "" Then
objCol.Add arrData(lngZeile, 2), IIf(IsNumeric(arrData(lngZeile, 2)), _
CStr(arrData(lngZeile, 2)), arrData(lngZeile, 2))
End If
Next_Zeile:
Err.Clear
Next
ReDim aTmp(1 To objCol.Count, 1 To 1)
For lngZeile = 1 To objCol.Count
aTmp(lngZeile, 1) = objCol(lngZeile)
Next
Me.ComboBox1.List = aTmp
Set objCol = Nothing
Label115.Caption = ""
End With
Fehler:
With Err
Select Case .Number
Case 0
Case 457
Resume Next_Zeile
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehler-prcGetAllData"
End Select
End With
End Sub
Sub prcGetFilteredData()                                            'geändert  fcs 2017-07-31
'gefilterte Daten einlesen
Dim wksData As Worksheet
Dim LoLetzte2 As Long
Dim lngI As Long
Dim i, Spalte As Long
Dim aTmp(), aListe() As Boolean
Dim objCol As New Collection
Dim varWert As Variant
On Error GoTo Fehler
Set wksData = Worksheets(sBlattname)
Me.ListBox1.Clear
With wksData
LoLetzte2 = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("D1").FormulaR1C1 = "=SUBTOTAL(2,R3C1:R65000C1)"
Label115.Caption = "gefilterte:  " & .Range("D1")
If LoLetzte2 > 2 Then
'Datensätze Zählen / zum Einlesen markieren
ReDim aListe(LBound(arrData, 1) To UBound(arrData, 1)) 'Array zum Markieren
varWert = Me.ComboBox1.Value
i = 0
If varWert = "" Then 'Liste wurde in Tabellenblatt vorgefiltert,ombobox1 aber _
noch nicht gesetzt
'Die sichtbaren Zeilen werden in der Liste markiert und gezählt
For lngI = LBound(arrData, 1) To UBound(arrData, 1)
If .Rows(arrData(lngI, 15)).Hidden = False Then
i = i + 1
aListe(lngI) = True
End If
Next lngI
Else
'Die mit dem Combobox-Wert übereinstimmenden Zeilen werdenmarkiert und gezählt
For lngI = LBound(arrData, 1) To UBound(arrData, 1)
If arrData(lngI, 2) = varWert Then
aListe(lngI) = True
i = i + 1
End If
Next lngI
End If
If i > 0 Then
'markierte Daten in Array einlesen
ReDim aTmp(1 To i, 1 To 15)
i = 0
objCol.Add "alle anzeigen", "alle anzeigen"
For lngI = LBound(arrData, 1) To UBound(arrData, 1)
If aListe(lngI) = True Then
i = i + 1
For Spalte = 1 To 15
aTmp(i, Spalte) = arrData(lngI, Spalte)
Next
If arrData(lngI, 2)  "" Then
objCol.Add arrData(lngI, 2), IIf(IsNumeric(arrData(lngI, 2)), _
CStr(arrData(lngI, 2)), arrData(lngI, 2))
End If
Next_lngI:
End If
Next lngI
Me.ListBox1.List = aTmp
ReDim aTmp(1 To objCol.Count, 1 To 1)
For lngI = 1 To objCol.Count
aTmp(lngI, 1) = objCol(lngI)
Next
Me.ComboBox1.List = aTmp
If objCol.Count = 2 Then
Me.ComboBox1.Value = varWert
End If
Erase aTmp
Set objCol = Nothing
End If
End If
End With
Fehler:
With Err
Select Case .Number
Case 0
Case 457
Resume Next_lngI
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehler-prcGetFilteredData"
End Select
End With
End Sub

Sorry Franz aber es klappt leider nicht
31.07.2017 09:27:38
philipp
Guten Morgen Franz,
SORRRRRYYYY aber es klappt nicht.
Wenn ich mg1 auswähle, werden in der Listbox 4 angezeigt aber in der
Tabelle alle 5. Da ist kein Unterschied zwischen MG1 und mg1.
Anbei die Datei:
https://www.herber.de/bbs/user/115144.xlsm
gruß
philipp b
Danke Franz und Matthias, es bleibt so --)
31.07.2017 13:04:39
philipp
Hallo Franz,
danke, ich lasse es so !
Habe MG1 in mg1 geändert !
gruß
philipp b

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige