Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
584to588
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
584to588
584to588
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Frage zum Code

Frage zum Code
19.03.2005 18:16:02
Sylvio
Hallo Experten,
habe diesen Code gefunden (original) und wollte ihn anpassen (geändert) aber irgendwas ist da falsch. Keine Ahnung was . :-(
Er sortiert nur die Combobox 2 richtig bei den anderen fehlen werte und leere Zellen werden angezeigt.
Könnt ihr helfen??
Danke im Voraus
MfG Sylvio


      
original:
Private Sub UserForm_Initialize()
   
Dim col As New Collection
   
Dim iRow As Integer
   iRow = 3
   
On Error Resume Next
   
Do Until IsEmpty(Cells(iRow, 1))
      col.Add Cells(iRow, 1), Cells(iRow, 1)
      
If Err = 0 Then
         ComboBox1.AddItem Cells(iRow, 1)
      
Else
         Err.Clear
      
End If
      iRow = iRow + 1
   
Loop
   
On Error GoTo 0
   ComboBox1.ListIndex = 0
End Sub
geändert:
Private Sub UserForm_Initialize()
   
Dim col As New Collection
   
Dim iRow As Integer
   iRow = 3
   
On Error Resume Next
   
Do Until IsEmpty(Cells(iRow, 1))
      col.Add Cells(iRow, 1), Cells(iRow, 1)
      
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 

     Code eingefügt mit Syntaxhighlighter 3.0

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Frage zum Code
19.03.2005 18:28:54
Ramses
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
AW: Damit prüft er auf Dubletten... oT
19.03.2005 18:33:47
Hans W. Hofmann
Gruß HW
Hübsche Variante. Danke o.T.
19.03.2005 18:42:20
Ramses
...
AW: Frage zum Code
19.03.2005 18:49:38
Sylvio
Hallo
Ok Sache verkannt. Aber er zeigt trotzdem nicht alle werte an.
Was die Collection soll weis ich nicht bin Anfänger .
Gruß Sylvio
Anzeige
AW: Frage zum Code
19.03.2005 20:24:25
Uwe Küstner
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
Anzeige
AW: Code zeigt Fehler 380!
19.03.2005 23:29:56
Sylvio
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
AW: Code zeigt Fehler 380!
20.03.2005 00:07:39
Uwe Küstner
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
AW: Code zeigt Fehler 380!
20.03.2005 00:41:06
Sylvio
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
Anzeige
AW: Code zeigt Fehler 380!
20.03.2005 15:49:14
Uwe Küstner
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
Anzeige
AW: Funzt! Eig.alle bis auf.....!
20.03.2005 16:59:12
Sylvio
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
AW: Funzt! Eig.alle bis auf.....!
20.03.2005 21:01:27
Uwe Küstner
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
Anzeige
AW: Funzt! Eig.alle bis auf.....!
20.03.2005 23:43:18
Sylvio
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
Anzeige
AW: Funzt! Eig.alle bis auf.....!
20.03.2005 23:57:13
Uwe Küstner
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
AW:Excel2002
21.03.2005 11:40:01
Sylvio
Hallo Uwe,
vielleicht funktioniert es mit Excel 2002 Version 10 so nicht.
Macht wirklich Problem wie schon beschrieben.
Mfg Sylvio
Jetzt aber ...
21.03.2005 13:56:41
Uwe Küstner
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
Anzeige
AW: genau
21.03.2005 19:25:41
Sylvio
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
und letzter Versuch mit Sortierung ;-)
22.03.2005 02:16:17
Uwe Küstner
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
Anzeige
AW: Perfektionist?
22.03.2005 21:35:32
Sylvio
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
AW: ich meine natürlich Küstner!
22.03.2005 21:45:01
Sylvio
............

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige