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

weitere Combobox einbauen - Fehlermeldung

weitere Combobox einbauen - Fehlermeldung
04.04.2014 12:16:54
Wolfgang
Hallo,
den folgenden Code habe ich hier aus dem Forum erhalten. Er funktioniert auch absolut tadellos -hinter einem UF mit 3 Comboboxes-. Mein Versuch, nun auf eine vierte Combobox auszuweiten, mit Bezug auf Spalte G, ist jämmerlich gescheitert. Es erscheint nun eine Fehlermeldung -Typen unverträglich-; Was müßte ich noch im Code verändern bzw. was habe ich falsch gemacht? - Danke schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Option Explicit
Private shGrunddaten As Worksheet, shErgebnis As Worksheet
Private Sub prcFill_Combobox1()
Dim i As Long, ii As Integer, inList As Boolean, c As Range
'Funktion:  ComboBox1 Spalte L
With ComboBox1
'.Clear
.ListRows = 0
.AddItem "(Alle)"
.AddItem "(Leere)"
.AddItem "(nicht Leere)"
.AddItem ""
With Sheets("Grunddaten")
i = .UsedRange.Row + .UsedRange.Rows.Count - 1
End With
For Each c In Sheets("Grunddaten").Range("L2:L" & Format(i, "0"))
If c.Text  "" Then
inList = False
For ii = 0 To .ListCount - 1
If .List(ii) = c.Text Then
inList = True
Exit For
End If
Next ii
If Not inList Then .AddItem c.Text
End If
Next c
SortCombobox ComboBox1
End With
End Sub
Private Sub prcFill_Combobox2()
Dim i As Long, ii As Integer, inList As Boolean, c As Range
'Funktion:  ComboBox2 Spalte O
With ComboBox2
.ListRows = 0
With Sheets("Grunddaten")
i = .UsedRange.Row + .UsedRange.Rows.Count - 1
End With
For Each c In Sheets("Grunddaten").Range("O2:O" & Format(i, "0"))
If c.Text  "" Then
inList = False
For ii = 0 To .ListCount - 1
If .List(ii) = c.Text Then
inList = True
Exit For
End If
Next ii
If Not inList Then .AddItem c.Text
End If
Next c
SortCombobox ComboBox2, bolNumeric:=True
End With
End Sub
Private Sub prcFill_Combobox3()
Dim i As Long, ii As Integer, inList As Boolean, c As Range
'Funktion:  ComboBox3 Spalte I
With ComboBox3
.ListRows = 0
.Clear
With shGrunddaten
i = .UsedRange.Row + .UsedRange.Rows.Count - 1
End With
For Each c In shGrunddaten.Range("I2:I" & Format(i, "0"))
If c.Text  "" Then
inList = False
For ii = 0 To .ListCount - 1
If .List(ii) = c.Text Then
inList = True
Exit For
End If
Next ii
If Not inList Then .AddItem c.Text
End If
Next c
SortCombobox ComboBox3, bolNumeric:=True
End With
End Sub
Private Sub prcFill_Combobox4()
Dim i As Long, ii As Integer, inList As Boolean, c As Range
'Funktion:  ComboBox3 Spalte I
With ComboBox4
.ListRows = 0
.Clear
With shGrunddaten
i = .UsedRange.Row + .UsedRange.Rows.Count - 1
End With
For Each c In shGrunddaten.Range("G2:G" & Format(i, "0"))
If c.Text  "" Then
inList = False
For ii = 0 To .ListCount - 1
If .List(ii) = c.Text Then
inList = True
Exit For
End If
Next ii
If Not inList Then .AddItem c.Text
End If
Next c
SortCombobox ComboBox4, bolNumeric:=True
End With
End Sub
Private Sub cmdExtrahieren_Click()
Dim sh As Worksheet
Dim maxID As Integer, gZeile As Long, eZeile As Long, cnt As Long
Dim newErgebnis As Boolean
'Zeilen durchsuchen und in neuen Blatt einfügen
For gZeile = 2 To shGrunddaten.UsedRange.Row + shGrunddaten.UsedRange.Rows.Count - 1 ' _
Start-Zeile ggf. anpassen
If (shGrunddaten.Range("L" & gZeile).Text = ComboBox1.Text _
Or (shGrunddaten.Range("L" & gZeile).Text = "" And ComboBox1.Text = "(Leere)") _
_
Or (shGrunddaten.Range("L" & gZeile).Text  "" And ComboBox1.Text = "(nicht  _
Leere)") _
Or ComboBox1.Text = "(Alle)") _
And _
(ComboBox2.Text = "" Or shGrunddaten.Range("O" & gZeile).Text = ComboBox2. _
Text) _
And _
(ComboBox3.Text = "" Or shGrunddaten.Range("I" & gZeile).Text = ComboBox3. _
Text) _
And _
(ComboBox4.Text = "" Or shGrunddaten.Range("G" & gZeile).Text = ComboBox4. _
Text) Then
If Not newErgebnis Then
With shErgebnis
.Visible = xlSheetVisible
cnt = .UsedRange.Row + .UsedRange.Rows.Count - 1
eZeile = 2                '1. Zeile in die Daten kopiert werden sollen -  _
ggf anpassen!!!!!
If cnt >= eZeile Then
'                       'Altdaten im Ergebnisblatt löschen
.Range(.Rows(eZeile), .Rows(cnt)).Delete shift:=xlShiftUp
End If
End With
cnt = 0
newErgebnis = True
End If
shErgebnis.Rows(eZeile).Value = shGrunddaten.Rows(gZeile).Value
eZeile = eZeile + 1: cnt = cnt + 1
End If
Next gZeile
If cnt Then
shErgebnis.Activate
MsgBox "Es wurden " & cnt & " Datensätze nach '" & shErgebnis.Name & "' extrahiert!" _
, _
vbInformation, "Extrahieren"
Sheets("Start").Activate
Unload Me
Else
MsgBox "Es konnten keine entsprechenden Datensätze gefunden werden", vbInformation,  _
_
"Extrahieren"
End If
End Sub
Private Sub SortCombobox(ComboboxObj As ComboBox, Optional bolNumeric As Boolean)
'bolNumeric - wenn True, dann wird die Auswahlliste nummerisch sortiert
Dim a As Long, b As Long, sTemp, vWerta, vWertb
With ComboboxObj
'Combobox sortieren :
For a = 0 To .ListCount - 1
vWerta = .List(a)
If bolNumeric = True Then vWerta = IIf(IsNumeric(.List(a)), CDbl(.List(a)), .List(a) _
)
For b = 0 To a - 1
vWertb = .List(b)
If bolNumeric = True Then vWertb = IIf(IsNumeric(.List(b)), CDbl(.List(b)), . _
List(b))
If vWertb > vWerta Then
sTemp = .List(b)
.List(b) = .List(a)
.List(a) = sTemp
End If
Next b
Next a
End With
End Sub
Private Sub ComboBox1_DropButtonClick()
'prcFill_Combobox1
End Sub
Private Sub ComboBox2_DropButtonClick()
'prcFill_Combobox2
End Sub
Private Sub ComboBox3_DropButtonClick()
'prcFill_Combobox3
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Set shGrunddaten = Sheets("Grunddaten")
Set shErgebnis = Sheets("Ergebnis")
prcFill_Combobox1
prcFill_Combobox2
prcFill_Combobox3
prcFill_Combobox4
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: weitere Combobox einbauen - Fehlermeldung
04.04.2014 12:29:01
Rudi
Hallo,
wo tritt der Fehler auf?
Sowas ist Quatsch: .Range("L2:L" & Format(i, "0"))
.Range("L2:L" & i) reicht.
Lad doch die Mappe hoch
Gruß
Rudi

AW: weitere Combobox einbauen - Fehlermeldung
04.04.2014 17:37:49
Wolfgang
Hallo Rudi,
danke für Deine Rückmeldung. Ich konnte zwischenzeitlich noch die Mustermappe aus dem Forum finden und habe sie hochgeladen. Mein Ziel wäre, den Code bzw. UF so zu erweitern, dass eine weitere Fitermöglichkeit über Combobox4 eingebaut wird und der Bezug in Spalte G liegt. Danke schon jetzt wieder für Deine Rückmeldung.
Gruß - Wolfgang
https://www.herber.de/bbs/user/89991.xls
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige