Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
19.04.2024 12:23:24
Wenn-Formel anpassen
19.04.2024 12:09:19
Unique (Application.WorksheetFunction.Unique)
19.04.2024 11:51:37
Nächsten identischen Treffer suchen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
744to748
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
744to748
744to748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bitte Dringend, Listbox, brauch ich ...

Bitte Dringend, Listbox, brauch ich ...
14.03.2006 13:40:21
walter
Hallo Zusammen,
hatte gestern schon reichlich mit Olaf, beni und Glen ensprechende Lösung versucht.
Habe in der Zwischenzeit, nach 10h "hartes" probieren etc.etwas gefunden,
ein aus Februar stammendes Beispiel von Peter ein Makro.
Leider werden die Daten nicht alle eingelesen sondern nur die Zeile 1 aus der gefilterten Mappe. Vielleicht kann mir jemand das ergänzen...
Makro:
ListBox1.RowSource = ""
Dim intZ As Integer
Dim myrng As Range, rng As Range
With Sheets("Lager")
Set myrng = Union(Range("A4:J4"), Range("K4:U4")) &lt&lt&lt&lt&lt&lt&lt ?
ReDim myarr(0, 0 To 22)
'ReDim myarr(0, 1 To 8) 'Orginal
For Each rng In .Range(myrng.Address)
myarr(0, intZ) = rng
intZ = intZ + 1
Next
End With
With UserForm4.ListBox1
.ColumnCount = 22
.List = myarr
End With
Wenn ich "A4:j1000" einsetze bricht ab, ich würde mich freuen, wenn
mir dies jemand "reparieren" kann oder ergänzen,
gruß Walter

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte Dringend, Listbox, brauch ich ...
14.03.2006 15:41:13
Peter
Servus,
lad mir mal deine Mappe hoch, dann passe ich dir das an.
Nur zur Info, Markiere mal den Befehl Union und drücke F1 ;-) Nun müsstest du wissen warum das nicht funkt..
Noch was du benötigst ja nur 10 Spalten (J), darum wird deine ListBox später sch... ausschauen, wenn Sie aber mit 22 Spalten eingestelt ist.
MfG Peter
Hmmm, warum eigentlich so kompliziert ?
14.03.2006 15:49:01
Peter
Servus,
wenn ich das richtig verstanden hab, dürfte das schon reichen.
Private Sub UserForm_Activate()
Dim myArr()
myArr = Range("A4:J1000")
With Me.ListBox1
.ColumnCount = UBound(myArr)
.List = myArr
End With
End Sub

MfG Peter
Anzeige
Leider nicht aber...
14.03.2006 17:18:11
walter
Hallo Peter,
schicke meine Datei, sind Vertrauliche Daten drin.
Wenn man in der Mappe Abgemeldete das Button drückt "TestFilter" bitte dann
Neuß auswählen 01, es sollen dann nur mit 01 ausgewählt werden (in der Mappe ist das so), du kannst die UF verschieben, dahinter sind die Daten zu sehen.
Wenn man ALLE drückt siehst Du wie sonst die Daten aussehen, darum brauch ich die Spalten.
https://www.herber.de/bbs/user/31907.zip
Ich würde mich FREUEN, bis nachher
gruß Walter
Wollte nur mal...
14.03.2006 19:49:55
Walter
Hallo Peter,
bin gerade nach Hause gekommen, wollte nur mal hören ob Du die
Datei so gebrauchen kannst ?
mfg Walter
Anzeige
AW: Wollte nur mal...
14.03.2006 19:56:50
Peter
Servus,
ja passt scho. Dauert aber a bisserl bis ich mich durch das Chaos gearbeitet habe.
MfG Peter
Danke bis..
14.03.2006 19:59:06
Walter
Hallo Peter,
Danke für die Info, "a bisserl" bist Du aus Bayern ?, na ja die haben halt auch einen
Excel-Experten,
bis später,
Walter
Hallo ich glaube ich bin...gut
14.03.2006 20:49:00
Walter
Hallo Peter,
nur schau DIR das mal an, hiermit wird auch selektiert:~f~
Private Sub OptionButton2_Click()
Dim c As Range
Dim Zeile As Integer
Dim z
Dim ze
Dim FI$
ActiveSheet.Unprotect (getStrPasswort)
Range("A3:AB3").Select
If Not ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
Range("E3").Select
ActiveSheet.Unprotect (getStrPasswort)
FI = "01"
Columns(sp).AutoFilter Field:=5, Criteria1:=FI '& "*", Operator:=xlAnd
Label6.Caption = ActiveSheet.Range("J2").Value
z = Range("a3").End(xlDown).Row
ze = FindFirstRow_in_Filter(Range("A4:U" & z))
'Range = ze
ActiveSheet.Unprotect (getStrPasswort)
'-------------------------------------------------------
'Dim c As Range
'Dim Zeile As Integer
'ListBox1.Clear
ListBox1.RowSource = ""
For Each c In Range("E3:E65000")
If c.Value = "1" Then
With ListBox1
.ColumnCount = 21
' .ColumnWidths = "2cm;2cm;3cm;3cm;2cm"
.ColumnWidths = "0,8cm;0cm;2,5cm;0,8cm;0,8cm;3,5cm;2,3cm;2,3cm;2,5cm;2cm;0cm;0cm;0cm;1,8cm;0cm;0cm;2cm;0cm;0cm;0cm;2cm;"
.AddItem c.Offset(0, -4).Value ' 4auf lf.Nr.
.List(Zeile, 1) = c.Offset(0, -3).Value 'ist Spalte "b" auf 0 setzen
.List(Zeile, 2) = c.Offset(0, -2).Value 'Nutzer
.List(Zeile, 3) = c.Offset(0, -1).Value 'Kennung
.List(Zeile, 4) = c.Offset(0, 0).Value 'Center
.List(Zeile, 5) = c.Offset(0, 1).Value 'Typ
.List(Zeile, 6) = c.Offset(0, 2).Value 'Auftragsnummer
Zeile = Zeile + 1
End With
End If
Next c
'-------------------------------------------------------------------------------
es ist so wie ich das brauche !!!!
Habe einfach auch mal weiter probiert, wollte doch Wissen ob ich das verstehe !!!
Hinter Auftragsnummer, wollte ich jetzt mal bis zur Spalte 21 weitermachen, das einzige,
ich kriege das Format nicht hin, beim Center müßte 01 stehen anstatt 1, komisch bei der "normalen" selektion von z.b. Center 04 werden die Formate angezeigt.
Ich hoffe Du kannst helfen...
mfg walter
Anzeige
AW: Und hier das Format ohne Hilfe
14.03.2006 20:51:48
Walter
Hallo Peter,
jetzt bin ich stolz, hier sogar das Format:
.List(Zeile, 4) = Format(c.Offset(0, 0).Value, "00") 'Center
gruß walter
AW: Und hier das Format ohne Hilfe
14.03.2006 21:21:04
Peter
Servus,
na das freut mich. Wäre vermutlich eh erst morgen dazugekommen.
Hock immer noch im Büro :-(.
P.S.: We rule da World und Meister wern ma sowieso ;-)
MfG Peter
Aber Wieso nur bis..
14.03.2006 21:24:01
Walter
Hallo Peter,
na ja , war nur kurz die Freude, geht nur bis 6 Wieso ?
.AddItem c.Offset(0, -4).Value ' 4auf lf.Nr.
.List(Zeile, 1) = c.Offset(0, -3).Value 'ist Spalte "b" auf 0 setzen
.List(Zeile, 2) = c.Offset(0, -2).Value 'Nutzer
.List(Zeile, 3) = c.Offset(0, -1).Value 'Kennung
.List(Zeile, 4) = Format(c.Offset(0, 0).Value, "00") 'Center
.List(Zeile, 5) = c.Offset(0, 1).Value 'Typ
.List(Zeile, 6) = c.Offset(0, 2).Value 'Auftragsnummer
.List(Zeile, 7) = c.Offset(0, 3).Value 'Kennzeichen
.List(Zeile, 8) = c.Offset(0, 4).Value 'Sonstiges
.List(Zeile, 9) = c.Offset(0, 5).Value 'Erstzulassung
' .List(Zeile, 10) = c.Offset(0, 6).Value 'K=
' .List(Zeile, 11) = c.Offset(0, 7).Value 'L
' .List(Zeile, 12) = c.Offset(0, 8).Value 'M
' .List(Zeile, 13) = Format(c.Offset(0, 9).Value, "0,000") 'KM
' .List(Zeile, 14) = c.Offset(0, 10).Value 'Erstzulassung
' .List(Zeile, 15) = c.Offset(0, 11).Value 'Erstzulassung
' .List(Zeile, 16) = c.Offset(0, 12).Value 'Erstzulassung
Zeile = Zeile + 1
End With
End If
Next c
geht nur bis Spalte 5= Erstzulassung, dann Fehlermeldung:
"Laufzeitfehler"380
Eigenschaft List konnte nicht gesetzt werden.UngültigerEigenschaftswert.?
Gruß Walter
Oder hast Du eine Lösung ?
Anzeige
AW: Aber Wieso nur bis..
14.03.2006 21:29:17
Peter
Servus,
weil bei gebundenen Listboxen nur max. 10 Spalten befüllt werden können.
Mit der Außnahme einer befüllung über einen Array.
Aber wie gesagt evtl. morgen mehr.
P.S.: Die erste Spalte = 0 und die letzte = 9
MfG Peter
Ja dann bis morgen...
14.03.2006 22:02:27
Walter
Hallo Peter,
na Du "ärmster", mach Schluß !
Danke für die Info, ich würde mich freuen, wenn Du mir eine Lösung bis so ca.
10,00Uhr anbieten könntest ?
Habe um 11.30 eine Präsentation und möchte die kompl. Datei vorführen, wie gesagt wäre nett !!!
Gute Nacht,
mfg Walter
Hallo habe Lösung...
15.03.2006 10:10:24
walter
Guten Morgen Peter,
habe gestern Abend noch eine Beispieldatei von Beni erhalten, funktioniert, muß noch ein wenig anpassen, funktioniert.
Würde mich trotzdem freuen von Dir ein Beispiel zu erhalten,
bis dann Walter
Hier das Makro kompl.:

Private Sub OptionButton2_Click()
Dim c As Range
Dim Zeile As Integer
Dim z
Dim ze
ActiveSheet.Unprotect (getStrPasswort)
Range("A3:AB3").Select
If Not ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
ComboBox1.ListIndex = -1
Range("F3").Select
Selection.AutoFilter Field:=5, Criteria1:="01"
If OptionButton2 = True Then
OptionButton2.ForeColor = &HFF&                    'Rot
OptionButton1.ForeColor = &H80000012               'Grün
OptionButton6.ForeColor = &H80000012               'Schwarz
OptionButton3.ForeColor = &H80000012               'Schwarz
OptionButton4.ForeColor = &H80000012               'Schwarz
OptionButton5.ForeColor = &H80000012               'Schwarz
End If
ActiveWindow.ScrollRow = 3           '8 Zeile
ActiveWindow.ScrollColumn = 2        '2 Spalte
Label6.Caption = ActiveSheet.Range("J2").Value
z = Range("a3").End(xlDown).Row
ze = FindFirstRow_in_Filter(Range("A4:U" & z))
ActiveSheet.Unprotect (getStrPasswort)
'------------------- funktioniert aber nur bis 9 Spalten --------------------------
'Dim c As Range
'Dim Zeile As Integer
'ListBox1.Clear
''ListBox1.RowSource = ""
''   For Each c In Range("E3:E65000")
''     If c.Value = "1" Then
''           With ListBox1
''              .ColumnCount = 21
' .ColumnWidths = "2cm;2cm;3cm;3cm;2cm"                     "K" "L" "M"
''  .ColumnWidths = "0,8cm;0cm;2,5cm;0,8cm;0,8cm;3,5cm;2,3cm;2,3cm;2,5cm;2cm;0cm;0cm;0cm;1,8cm;0cm;0cm;2cm;0cm;0cm;0cm;2cm;"
''              .AddItem c.Offset(0, -4).Value                ' 4auf lf.Nr.
''               .List(Zeile, 1) = c.Offset(0, -3).Value       'ist Spalte "b" setzen
''              .List(Zeile, 2) = c.Offset(0, -2).Value         'Nutzer
''              .List(Zeile, 3) = c.Offset(0, -1).Value         'Kennung
''              .List(Zeile, 4) = Format(c.Offset(0, 0).Value, "00")       'Center
''              .List(Zeile, 5) = c.Offset(0, 1).Value           'Typ
''             .List(Zeile, 6) = c.Offset(0, 2).Value           'Auftragsnummer
''             .List(Zeile, 7) = c.Offset(0, 3).Value           'Kennzeichen
''             .List(Zeile, 8) = c.Offset(0, 4).Value           'Sonstiges
''             .List(Zeile, 9) = c.Offset(0, 5).Value          'Erstzulassung
'  .List(Zeile, 10) = c.Offset(0, 6).Value           'K=
'  .List(Zeile, 11) = c.Offset(0, 7).Value           'L
'  .List(Zeile, 12) = c.Offset(0, 8).Value           'M
'  .List(Zeile, 13) = Format(c.Offset(0, 9).Value, "0,000")     'KM
'  .List(Zeile, 14) = c.Offset(0, 10).Value           'Erstzulassung
'  .List(Zeile, 15) = c.Offset(0, 11).Value           'Erstzulassung
'  .List(Zeile, 16) = c.Offset(0, 12).Value           'Erstzulassung
''             Zeile = Zeile + 1
''         End With
''    End If
'' Next c
'-------------- das ist von Beni 14-3-06 ---------------------------------------
With ListBox1
'    .ListStyle = fmListStyleOption                'Orginal sind die Kreise vorn weg
Dim arrValues() As Variant
'Dim i, intRow As Integer, intRowU, z As Integer      'Orginal
Dim i, intRow As Integer, intRowU As Integer
'ListBox1.Clear
ListBox1.RowSource = ""
z = ActiveSheet.Range("a3").End(xlDown).Row
For intRow = 4 To z                                 'war 2 da war kompl.Überschriften
If ActiveSheet.Rows(intRow).EntireRow.Hidden = False Then
ReDim Preserve arrValues(0 To 20, 0 To intRowU)
arrValues(0, intRowU) = ActiveSheet.Cells(intRow, 1)           'lf.Nr.
arrValues(1, intRowU) = ActiveSheet.Cells(intRow, 2)
arrValues(2, intRowU) = ActiveSheet.Cells(intRow, 3)
arrValues(3, intRowU) = ActiveSheet.Cells(intRow, 4)
arrValues(4, intRowU) = Format(ActiveSheet.Cells(intRow, 5), "00")  'Center
arrValues(5, intRowU) = ActiveSheet.Cells(intRow, 6)
arrValues(6, intRowU) = ActiveSheet.Cells(intRow, 7)
arrValues(7, intRowU) = ActiveSheet.Cells(intRow, 8)
arrValues(8, intRowU) = ActiveSheet.Cells(intRow, 9)
arrValues(9, intRowU) = ActiveSheet.Cells(intRow, 10)
arrValues(10, intRowU) = ActiveSheet.Cells(intRow, 11)
arrValues(11, intRowU) = ActiveSheet.Cells(intRow, 12)
arrValues(12, intRowU) = ActiveSheet.Cells(intRow, 13)
arrValues(13, intRowU) = Format(ActiveSheet.Cells(intRow, 14), "0,000")   'KM
arrValues(14, intRowU) = Format(ActiveSheet.Cells(intRow, 15), "0,000.00")
arrValues(15, intRowU) = ActiveSheet.Cells(intRow, 16)
arrValues(16, intRowU) = Format(ActiveSheet.Cells(intRow, 17), "0.00")    ' Kulanz%
arrValues(17, intRowU) = ActiveSheet.Cells(intRow, 18)
arrValues(18, intRowU) = ActiveSheet.Cells(intRow, 19)
arrValues(19, intRowU) = ActiveSheet.Cells(intRow, 20)
arrValues(20, intRowU) = Format(ActiveSheet.Cells(intRow, 21), "0,000.00")
intRowU = intRowU + 1
End If
Next intRow
.ColumnCount = 21
.ColumnWidths = "0,8cm;0cm;2,5cm;0,8cm;0,8cm;3,5cm;2,3cm;2,3cm;2,5cm;2cm;0cm;0cm;0cm;1,8cm;0cm;0cm;2cm;0cm;0cm;0cm;2cm;"
If intRowU <> 0 Then ListBox1.Column = arrValues
End With
End Sub

Anzeige
AW: Hallo habe Lösung...
15.03.2006 16:02:18
geschlossen
g
AW: Hallo habe Lösung...
15.03.2006 17:44:04
Peter
Servus,
zum ersten, nimm die Lösung die funktioniert. Nur mal als Bsp. habs aber nicht getestet.


Private Sub OptionButton2_Click()
    Dim rngFilter As Range, rng As Range, rngArr(0 To 3) As Range
    Dim lZeile As Long, lRow As Long, lCol As Long
    Dim arrZ As Integer, intSp As Integer
    Dim strCrit As String
    Dim myarr()
    strCrit = "01"
    With Sheets("Abgemeldete")
        lZeile = .Cells(.Rows.Count, 5).End(xlUp).Row
        If Not .AutoFilterMode Then _
            .Range("A3:AB3").AutoFilter
        .Range("A3:AB" & lZeile).AutoFilter field:=5, Criteria1:=strCrit
        Me.Label6 = .Range("J2")
        ReDim Preserve myarr(0 To .Range("J2"), 0 To 22)
        Set rngArr(0) = .Range("C4:J" & lZeile).SpecialCells(XlCellType.xlCellTypeVisible)
        Set rngArr(1) = .Range("N4:N" & lZeile).SpecialCells(XlCellType.xlCellTypeVisible)
        Set rngArr(2) = .Range("Q4:Q" & lZeile).SpecialCells(XlCellType.xlCellTypeVisible)
        Set rngArr(3) = .Range("U4:U" & lZeile).SpecialCells(XlCellType.xlCellTypeVisible)
        Set rngFilter = Union(rngArr(0), rngArr(1), rngArr(2), rngArr(3))
        For Each rng In rngFilter
            If lRow <> 0 And lRow < rng.Row Then arrZ = arrZ + 1
            If rng.Column > 10 And rng.Row < lRow Then arrZ = 0
            If rng.Column = 3 And lCol > 0 Then
                intSp = 0
            ElseIf rng.Column > lCol Then intSp = intSp + 1
            End If
            myarr(arrZ, intSp) = rng.Text
            lCol = rng.Column
            lRow = rng.Row
        Next
    End With
    With Me.ListBox1
        .ColumnCount = UBound(myarr)
        .RowSource = ""
        .List = myarr
    End With
End Sub


Zum zweiten, wenn du mit der Datei noch länger arbeiten willst, ist es dringend von Nöten Sie von dem Code Wirwar zu befreien. Viel Spaß noch.
MfG Peter
Anzeige
Danke o.t.
15.03.2006 21:28:22
Walter
Hallo Peter,
Danke für den Einsatz und die Tips !!!
Gruß Walter

Links zu Excel-Dialogen

ListBox OptionButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige