Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Frage zum Code

Informationen und Beispiele zu den hier genannten Dialog-Elementen:

Frage zum Code von Sylvio vom 19.03.2005 18:16:02

AW: Frage zum Code - von Ramses am 19.03.2005 18:28:54
- AW: Damit prüft er auf Dubletten... oT - von Hans W. Hofmann am 19.03.2005 18:33:47
  - Hübsche Variante. Danke o.T. - von Ramses am 19.03.2005 18:42:20
AW: Frage zum Code - von Sylvio am 19.03.2005 18:49:38
- AW: Frage zum Code - von Uwe Küstner am 19.03.2005 20:24:25
  - AW: Code zeigt Fehler 380! - von Sylvio am 19.03.2005 23:29:56
    - AW: Code zeigt Fehler 380! - von Uwe Küstner am 20.03.2005 00:07:39
      - AW: Code zeigt Fehler 380! - von Sylvio am 20.03.2005 00:41:06
        
        AW: Code zeigt Fehler 380! - von Uwe Küstner am 20.03.2005 15:49:14
        
        AW: Funzt! Eig.alle bis auf.....! - von Sylvio am 20.03.2005 16:59:12
        
        AW: Funzt! Eig.alle bis auf.....! - von Uwe Küstner am 20.03.2005 21:01:27
        
        AW: Funzt! Eig.alle bis auf.....! - von Sylvio am 20.03.2005 23:43:18
        
        AW: Funzt! Eig.alle bis auf.....! - von Uwe Küstner am 20.03.2005 23:57:13
        
        AW:Excel2002 - von Sylvio am 21.03.2005 11:40:01
        
        Jetzt aber ... - von Uwe Küstner am 21.03.2005 13:56:41
        
        AW: genau - von Sylvio am 21.03.2005 19:25:41
        
        und letzter Versuch mit Sortierung ;-) - von Uwe Küstner am 22.03.2005 02:16:17
        
        AW: Perfektionist? - von Sylvio am 22.03.2005 21:35:32
        
        AW: ich meine natürlich Küstner! - von Sylvio am 22.03.2005 21:45:01

Betrifft: Frage zum Code
von: Sylvio

Geschrieben am: 19.03.2005 18:16:02
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

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
............