Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1212to1216
1212to1216
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Listbox füllen in UF

Forumthread: Listbox füllen in UF

Listbox füllen in UF
robert
Hi,
entweder ist es die Hitze, oder ich steh am Schlauch, oder.....
Problem- sieh Beispieldatei-
https://www.herber.de/bbs/user/74987.xls
es sollen die Zeilen mit X in die Listbox, X und Betrag
aber wenn hintereinander zB.
X 50
X -50
dann keine Übernahme.
Danke und Gruß
robert
Anzeige

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Listbox füllen in UF
24.05.2011 16:08:05
VolkerM
Hallo Robert,
versuch mal:
Private Sub UserForm_Activate()
Dim arr() As Variant
Dim iRowL As Integer, iRow As Integer, iRowU As Integer
ListBox1.Clear
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iRowL
If Cells(iRow, 1).Value = "X" And _
Cells(iRow + 1, 1).Value  "X" And _
Cells(iRow - 1, 1).Value  "X" Then
ReDim Preserve arr(0 To 1, 0 To iRowU)
arr(0, iRowU) = Cells(iRow, 1)
arr(1, iRowU) = Cells(iRow, 2)
iRowU = iRowU + 1
End If
Next iRow
ListBox1.Column = arr
End Sub
Gruß Volker
Anzeige
AW: Listbox füllen in UF
24.05.2011 16:32:14
robert
Hi Volker,
leider nein.....
in Spalte A stehen Texte, in Spalte B stehen Beträge
wenn in Spalte A ein X, dann in Listbox eintragen...
wenn in Spalte A zwei X hintereinander stehen und der Betrag einmal
positiv und einmal negativ ist, keine Übernahme in Listbox.
Gruß
robert
Anzeige
AW: Listbox füllen in UF
24.05.2011 17:26:05
VolkerM
Hi Robert,
vlt so: 
Private Sub UserForm_Activate()
Dim arr() As Variant
Dim iRowL As Integer, iRow As Integer, iRowU As Integer
ListBox1.Clear
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iRowL
If Cells(iRow, 1).Value = "X" Then
If Cells(iRow + 1, 1).Value  "X" Then
If Cells(iRow - 1, 1).Value  "X" Then
If Not Left(Cells(iRow, 2), 1) = "-" Then
If Not Left(Cells(iRow + 1, 2), 1) = "-" Then
ReDim Preserve arr(0 To 1, 0 To iRowU)
arr(0, iRowU) = Cells(iRow, 1)
arr(1, iRowU) = Cells(iRow, 2)
iRowU = iRowU + 1
End If
End If
End If
End If
End If
Next iRow
ListBox1.Column = arr
End Sub
Gruß Volker
Anzeige
AW: Listbox füllen in UF
24.05.2011 17:35:47
ransi
Hallo
ich versuchs mal:
Option Explicit

Private Sub CommandButton1_Click()
    Dim arr
    Dim L As Long, z As Long, iRowL As Long
    iRowL = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A2:B" & iRowL)
    Redim out(1 To 2, 1 To UBound(arr))
    For L = LBound(arr) To UBound(arr) - 1
        If arr(L, 1) & arr(L + 1, 1) = "xx" Then 'wenn in Spalte A zwei X hintereinander stehen...
            Select Case Sgn(arr(L, 2)) & Sgn(arr(L + 1, 2))
                Case "-11", "1,-1" 'und der Betrag einmal positiv und einmal negativ ist,keine Übernahme in Listbox.
                Case Else:
                    z = z + 1
                    out(1, z) = arr(L, 1)
                    out(2, z) = arr(L, 2)
            End Select
        End If
    Next
    Redim Preserve out(1 To 2, 1 To z)
    out = WorksheetFunction.Transpose(out)
    ListBox1.List = out
End Sub


ransi
Anzeige
@ransi u.Volker..
24.05.2011 18:14:00
robert
Hallo,
noch einmal das Problem, habs anscheinend falsch rübergebracht ;-)
in Spalte A stehen untereinander einige X, in Spalte B ein Betrag.
zB.in A1:A100 steht ein X, wenn nun in der Spalte B ein positiver Betrag ist
und in der nächsten Zeile der gleich Betrag negativ ist,
dann sollen diese 2 Zeilen nicht ! übernommen werden.( gleicher + und - Betrag)
Ich hoffe, es ist verständlicher
Gruß
robert
Anzeige
AW: @ransi u.Volker..
24.05.2011 19:01:11
VolkerM
Hi Robert,
Nächster Versuch:
Private Sub UserForm_Activate()
On Error Resume Next
Dim arr() As Variant
Dim iRowL As Integer, iRow As Integer, iRowU As Integer
ListBox1.Clear
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iRowL
If Cells(iRow, 1).Value = "X" Then
If Not Left(Cells(iRow, 2), 1) = "-" And Left(Cells(iRow + 1, 2), 1)  "-" Or _
Not Left(Cells(iRow, 2), 1) = "-" And Left(Cells(iRow + 1, 2), 1) = "-" Then
If Not Cells(iRow, 2).Value = Left(Cells(iRow + 1, 2), -1) Then
ReDim Preserve arr(0 To 1, 0 To iRowU)
arr(0, iRowU) = Cells(iRow, 1)
arr(1, iRowU) = Cells(iRow, 2)
iRowU = iRowU + 1
End If
End If
End If
Next iRow
ListBox1.Column = arr
End Sub

Gruß Volker
Anzeige
AW: @ransi u.Volker..
24.05.2011 19:30:31
VolkerM
Hi,
so? 
Private Sub UserForm_Activate()
On Error Resume Next
Dim arr() As Variant
Dim iRowL As Integer, iRow As Integer, iRowU As Integer
ListBox1.Clear
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iRowL
If Cells(iRow, 1).Value = "X" Then
If Not Left(Cells(iRow, 2), 1)  "-" And Left(Cells(iRow + 1, 2), 1) = "-" Or _
Not Left(Cells(iRow + 1, 2), 1) = "-" And Left(Cells(iRow, 2), 1)  "-" Then
If Not Cells(iRow, 2).Value = Left(Cells(iRow + 1, 2), -1) Then
If Not Cells(iRow, 2).Value = Left(Cells(iRow - 1, 2), -1) Then
ReDim Preserve arr(0 To 1, 0 To iRowU)
arr(0, iRowU) = Cells(iRow, 1)
arr(1, iRowU) = Cells(iRow, 2)
iRowU = iRowU + 1
End If
End If
End If
End If
Next iRow
ListBox1.Column = arr
End Sub
Gruß Volker
Anzeige
Ja Volker ! das ist es-Danke u.Gruß
24.05.2011 19:36:37
robert
owT ;-)
AW:Listbox
24.05.2011 19:05:05
hary
hallo Robert
Als Ansatz(Listbox mit 2 Spalten). Mit Schleife, da Array noch nicht so mein Ding ist. :-(
Evtl. anpasen der if bedingung bekommst Du ja hin.
https://www.herber.de/bbs/user/74994.xls
gruss hary
Code: 

Option Explicit
Private Sub UserForm_Initialize()
Dim rng As Range
With ListBox1
For Each rng In Range("A2:A19")
If rng.Value = "X" And rng.Offset(1, 0)  "X" And rng.Offset(0, 1).Value > 0 Then
.AddItem rng.Value
.List(.ListCount - 1, 1) = rng.Offset(0, 1)
End If
Next
End With
End Sub

Anzeige
AW: AW:Listbox
24.05.2011 19:24:28
robert
Danke hary,
aber auch nicht die Lösung ;-(
Füge mal in Deine Datei in Spalte A2:A19 lauter X ein.....
Gruß
robert
Dank auch an ransi u.hary ;-) owT
24.05.2011 19:45:17
robert
;

Beliebteste Forumthreads (12 Monate)

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