Betrifft: AW: Frage zum Code
von: Ramses
Geschrieben am: 19.03.2005 18:28:54
Hallo
Blöde Frage:
Was hat das mit Sortieren zu tun?
Es ist keine einzige Sortieranweisung im Code.
Das einzige was dein Code machen müsste/sollte den Wert aus der Zeile "iRow" und den Spalten A,C und E nehmen und in die Combobox einfügen.
Das sollte er auch tun, da sehe ich eigentlich keine Probleme.
Nur für warum dafür eine Collection nötig sein sollte, verstehe ich nicht.
Gruss Rainer
Betrifft: AW: Damit prüft er auf Dubletten... oT
von: Hans W. Hofmann
Geschrieben am: 19.03.2005 18:33:47
Gruß HW
Betrifft: Hübsche Variante. Danke o.T.
von: Ramses
Geschrieben am: 19.03.2005 18:42:20
...
Betrifft: AW: Frage zum Code
von: Sylvio
Geschrieben am: 19.03.2005 18:49:38
Hallo
Ok Sache verkannt. Aber er zeigt trotzdem nicht alle werte an.
Was die Collection soll weis ich nicht bin Anfänger .
Gruß Sylvio
Betrifft: AW: Frage zum Code
von: Uwe Küstner
Geschrieben am: 19.03.2005 20:24:25
Hallo Sylvio,
probier es mal so.
Jetzt wird jede Spalte für sich geprüft.
Private Sub UserForm_Initialize()
Dim col As New Collection
Dim irow As Integer
irow = 3
On Error Resume Next
Do Until Cells(irow, 1) & Cells(irow, 3) & Cells(irow, 5) = ""
col.Add Cells(irow, 1), Cells(irow, 1)
If Err = 0 Then
ComboBox1.AddItem Cells(irow, 1)
Else
Err.Clear
End If
col.Add Cells(irow, 3), Cells(irow, 3)
If Err = 0 Then
ComboBox2.AddItem Cells(irow, 3)
Else
Err.Clear
End If
col.Add Cells(irow, 5), Cells(irow, 5)
If Err = 0 Then
ComboBox3.AddItem Cells(irow, 5)
Else
Err.Clear
End If
irow = irow + 1
Loop
On Error GoTo 0
ComboBox1.ListIndex = 0
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
End Sub
Gruß Uwe
Betrifft: AW: Code zeigt Fehler 380!
von: Sylvio
Geschrieben am: 19.03.2005 23:29:56
Hallo ,
der Code funzt nicht. Zeigt Laufzeitfehler 380!
Hier ist mal die Mappe die ich im Forum gefunden habe.
https://www.herber.de/bbs/user/19887.xls
Gruss Sylvio
Betrifft: AW: Code zeigt Fehler 380!
von: Uwe Küstner
Geschrieben am: 20.03.2005 00:07:39
Hallo Sylvio,
dann musst Du die Zeile
On Error Resume Next
gelöscht oder deaktiviert haben.
Denn diese Anweisung unterdrückt
diese Fehlermeldungen.
Gruß Uwe
Betrifft: AW: Code zeigt Fehler 380!
von: Sylvio
Geschrieben am: 20.03.2005 00:41:06
Hallo Uwe,
On Error Resume Next steht drin.
Wenn kein Problem kannst du dir ja mal die Mappe anschauen.siehe oben.
Habe den Code von dir dort eingefügt.
MfG Sylvio
Betrifft: AW: Code zeigt Fehler 380!
von: Uwe Küstner
Geschrieben am: 20.03.2005 15:49:14
Hallo Sylvio,
mit folgendem Code gehen keine Werte verloren:
Private Sub UserForm_Initialize()
Dim col As New Collection
Dim iRow As Integer
Dim sZeile As String
iRow = 3
On Error Resume Next
Do Until IsEmpty(Cells(iRow, 1))
sZeile = Cells(iRow, 1) & Cells(iRow, 3) & Cells(iRow, 5)
col.Add sZeile, sZeile
If Err = 0 Then
ComboBox1.AddItem Cells(iRow, 1)
ComboBox2.AddItem Cells(iRow, 3)
ComboBox3.AddItem Cells(iRow, 5)
Else
Err.Clear
End If
iRow = iRow + 1
Loop
On Error GoTo 0
ComboBox1.ListIndex = 0
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
End Sub
Aber eigentlich ist das Alles nur ein Stochern im Nebel,
da Du nicht geschrieben hast, wie Du Dir die Ausgabe in den
Comboboxen vorstellst: Sollen alle oder nur nach bestimmten
Kriterien gefilterte Zeilen in die Boxen kommen?
Gruß Uwe
Betrifft: AW: Funzt! Eig.alle bis auf.....!
von: Sylvio
Geschrieben am: 20.03.2005 16:59:12
Hallo Uwe,
Jetzt geht es ohne Fehlermeldung.Danke erstmal für deine Mühe und Gedult.
Eigentlich dachte ich mir das so die CB sollten keine Doppelten Werte und keine Leerzellen anzeigen.
MfG Sylvio
Betrifft: AW: Funzt! Eig.alle bis auf.....!
von: Uwe Küstner
Geschrieben am: 20.03.2005 21:01:27
Hallo Sylvio,
so sollte es klappen:
Private Sub UserForm_Initialize()
Dim iRow As Long
Dim iColumn As Integer
Dim iLZ As Long 'letzte belegte Zeile
Dim iZ As Long 'Zeile in Schleife
Dim rngQ As Range 'Quellbereich
Dim rngZ As Range 'Zielbereich für Spezialfilter
Dim wsA As Worksheet
Set wsA = ActiveSheet
iRow = 3
Application.ScreenUpdating = False
iColumn = 1 'Spalte A für ComboBox1
iLZ = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row 'letzte belegte Zelle der Spalte
If Not iLZ < iRow Then
If iLZ = iRow Then
ComboBox1.AddItem wsA.Cells(iRow, iColumn).Value
Else
Set rngZ = Workbooks.Add(xlWorksheet).Sheets(1).Cells(1)
wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rngZ, Unique:=True
Set rngZ = rngZ.Parent.UsedRange
If rngZ.Cells(1) = rngZ.Cells(2) Then rngZ.Cells(1).Delete
rngZ.Sort rngZ 'Liste wird sortiert
If rngZ.Cells.Count = 1 Then
ComboBox1.AddItem rngZ.Value
Else
ComboBox1.List = rngZ.Cells(1).CurrentRegion.Value
End If
rngZ.Parent.Parent.Close False
End If
ComboBox1.ListIndex = 0
End If
iColumn = 3 'Spalte C für ComboBox2
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
If Not iLZ < iRow Then
If iLZ = iRow Then
ComboBox2.AddItem wsA.Cells(iRow, iColumn).Value
Else
Set rngZ = Workbooks.Add(xlWorksheet).Sheets(1).Cells(1)
wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rngZ, Unique:=True
Set rngZ = rngZ.Parent.UsedRange
If rngZ.Cells(1) = rngZ.Cells(2) Then rngZ.Cells(1).Delete
rngZ.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
rngZ.Sort rngZ 'Liste wird sortiert
If rngZ.Cells.Count = 1 Then
ComboBox2.AddItem rngZ.Value
Else
ComboBox2.List = rngZ.Value
End If
rngZ.Parent.Parent.Close False
End If
ComboBox2.ListIndex = 0
End If
iColumn = 5 'Spalte E für ComboBox3
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
If Not iLZ < iRow Then
If iLZ = iRow Then
ComboBox3.AddItem wsA.Cells(iRow, iColumn).Value
Else
Set rngZ = Workbooks.Add(xlWorksheet).Sheets(1).Cells(1)
wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rngZ, Unique:=True
Set rngZ = rngZ.Parent.UsedRange
If rngZ.Cells(1) = rngZ.Cells(2) Then rngZ.Cells(1).Delete
rngZ.Sort rngZ 'Liste wird sortiert
If rngZ.Cells.Count = 1 Then
ComboBox3.AddItem rngZ.Value
Else
ComboBox3.List = rngZ.Cells(1).CurrentRegion.Value
End If
rngZ.Parent.Parent.Close False
End If
ComboBox3.ListIndex = 0
End If
Application.ScreenUpdating = True
End Sub
Gruß Uwe

 |
Betrifft: AW: Funzt! Eig.alle bis auf.....!
von: Sylvio
Geschrieben am: 20.03.2005 23:43:18
Hallo Uwe,
habe gleich mal wieder getestet leider mit Problem.
Kannst du dir das bitte noch mal anschauen?
Funktioniert nur wenn Excel vorher geöffnet ist. Wenn ich die Mappe direkt anklicke ohne das Excel activ ist passiert folgendes:
bei Klick auf Command Button in Tabelle1 zeigt er Laufzeitfehler ‚424’ Objekt erforderlich. Wenn ich bei der Fehlermeldung auf Beenden klicke öffnet eine neue Tabelle1 und er löscht die Werte aus A3:A bis auf den letzten den schiebt er nach A1.
Liegt der Fehler bei mir? Habe ich zu wenig oder falsche angaben gemacht?
Mfg Sylvio
Betrifft: AW: Funzt! Eig.alle bis auf.....!
von: Uwe Küstner
Geschrieben am: 20.03.2005 23:57:13
Hallo Sylvio,
ich verstehe Bahnhof. Bei mir geht das auch nur mit geöffnetem Excel.
Wie auch sonst?. Hier mal die geänderte Mappe von Dir.
Funktioniert bei mir einwandfrei(XL97).
Die Datei https://www.herber.de/bbs/user/19914.xls wurde aus Datenschutzgründen gelöscht
Gruß Uwe
Betrifft: AW:Excel2002
von: Sylvio
Geschrieben am: 21.03.2005 11:40:01
Hallo Uwe,
vielleicht funktioniert es mit Excel 2002 Version 10 so nicht.
Macht wirklich Problem wie schon beschrieben.
Mfg Sylvio
Betrifft: Jetzt aber ...
von: Uwe Küstner
Geschrieben am: 21.03.2005 13:56:41
Hallo Sylvio,
... sollte es klappen:
Private Sub UserForm_Initialize()
Dim iRow As Long
Dim iColumn As Integer
Dim Cn As New Collection
Dim iLZ As Long 'letzte belegte Zeile
Dim iZ As Long 'Zeile in Schleife
Dim rngQ As Range 'Quellbereich
Dim rngZ As Range 'Zielbereich für Spezialfilter
Dim wsA As Worksheet
Set wsA = ActiveSheet
iRow = 3
On Error Resume Next
iColumn = 1 'Spalte A für ComboBox1
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
Set rngQ = wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn))
If Not iLZ < iRow Then
For Each rngZ In rngQ
Cn.Add CStr(rngZ.Text), CStr(rngZ.Text)
Next rngZ
For iZ = 1 To Cn.Count
If Len(Cn(iZ)) > 0 Then ComboBox1.AddItem Cn(iZ)
Next iZ
ComboBox1.ListIndex = 0
Set Cn = Nothing
End If
iColumn = 3 'Spalte C für ComboBox2
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
Set rngQ = wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn))
If Not iLZ < iRow Then
For Each rngZ In rngQ
Cn.Add CStr(rngZ.Text), CStr(rngZ.Text)
Next rngZ
For iZ = 1 To Cn.Count
If Len(Cn(iZ)) > 0 Then ComboBox2.AddItem Cn(iZ)
Next iZ
ComboBox2.ListIndex = 0
Set Cn = Nothing
End If
iColumn = 5 'Spalte C für ComboBox3
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
Set rngQ = wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn))
If Not iLZ < iRow Then
For Each rngZ In rngQ
Cn.Add CStr(rngZ.Text), CStr(rngZ.Text)
Next rngZ
For iZ = 1 To Cn.Count
If Len(Cn(iZ)) > 0 Then ComboBox3.AddItem Cn(iZ)
Next iZ
ComboBox3.ListIndex = 0
Set Cn = Nothing
End If
On Error GoTo 0
End Sub
Gruß Uwe
https://www.herber.de/bbs/user/19944.xls
Betrifft: AW: genau
von: Sylvio
Geschrieben am: 21.03.2005 19:25:41
Hallo Uwe,
war ja echt ’ne schwere Geburt, oder?! Aber jetzt funktioniert es.
Er sortiert zwar nicht mehr aber das ist mir jetzt auch sch… egal.
Nochmals vielen Dank für deine Gedult und Mühe.
MfG Sylvio
Betrifft: und letzter Versuch mit Sortierung ;-)
von: Uwe Küstner
Geschrieben am: 22.03.2005 02:16:17
Hallo Sylvio,
und hier noch mal ein Versuch mit Sortierung:
Private Sub UserForm_Initialize()
Dim iRow As Long
Dim iColumn As Integer
Dim iLZ As Long 'letzte belegte Zeile
Dim rngQ As Range 'Quellbereich
Dim rngZ As Range 'Zeile in Schleife
Dim wsA As Worksheet
Set wsA = ActiveSheet
iRow = 3
iColumn = 1 'Spalte A für ComboBox1
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
Set rngQ = wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn))
If Not iLZ < iRow Then
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
rngQ.Copy ActiveSheet.Cells(1)
Columns(1).Sort Cells(1)
Set rngQ = Cells(1).CurrentRegion
For Each rngZ In rngQ
If rngZ.Offset(1, 0) <> rngZ Then ComboBox1.AddItem rngZ
Next rngZ
ComboBox1.ListIndex = 0
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End If
iColumn = 3 'Spalte C für ComboBox2
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
Set rngQ = wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn))
If Not iLZ < iRow Then
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
rngQ.Copy ActiveSheet.Cells(1)
Columns(1).Sort Cells(1)
Set rngQ = Cells(1).CurrentRegion
For Each rngZ In rngQ
If rngZ.Offset(1, 0) <> rngZ Then ComboBox2.AddItem rngZ
Next rngZ
ComboBox2.ListIndex = 0
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End If
iColumn = 5 'Spalte C für ComboBox3
iLZ = wsA.Cells(wsA.Rows.Count, iColumn).End(xlUp).Row 'letzte belegte Zelle der Spalte
Set rngQ = wsA.Range(wsA.Cells(iRow, iColumn), wsA.Cells(iLZ, iColumn))
If Not iLZ < iRow Then
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
rngQ.Copy ActiveSheet.Cells(1)
Columns(1).Sort Cells(1)
Set rngQ = Cells(1).CurrentRegion
For Each rngZ In rngQ
If rngZ.Offset(1, 0) <> rngZ Then ComboBox3.AddItem rngZ
Next rngZ
ComboBox3.ListIndex = 0
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End If
End Sub
Gruß Uwe

 |
Betrifft: AW: Perfektionist?
von: Sylvio
Geschrieben am: 22.03.2005 21:35:32
Hallo Uwe,
funktioniert wunderbar!
hätte aber nicht sein brauchen. Gott sei Dank gibts ja noch Perfektionisten wie Uwe Kästner.
Nochmals vielen Dank für die Hilfe.
Mit freundlichen Gruß
Sylvio
Betrifft: AW: ich meine natürlich Küstner!
von: Sylvio
Geschrieben am: 22.03.2005 21:45:01
............