Clever-Excel-Forum

Seiten: 1 2 3

Hallo Arni,

zeig doch mal, wie Du Dir diese Anzeige in einer ListBox vorstellst.
Ich würde da eventuell 3 zusätzliche TextBoxen für diese Anzeige verwenden.

Gruß Uwe

Hallo Uwe,

habe Dir ein Bild angehangen.

Gruß Arni

Hallo Arni,

das sollte ja schon in der ListBox stehen, wenn man sie so füllt:

Private Sub CommandButton1_Click()

   Dim myLookAt As XlLookAt, strFirstAddress As String, rngFound As Range   'Suchart, Erste Adresse als Zeichenfolge, Bereich

   

   If Len(TextBox1.Text) = 0 Then    'Textbox leer ??

      MsgBox "Suchtext eingeben"

      Exit Sub

   End If

  

   myLookAt = IIf(CheckBox1.Value, xlPart, xlWhole)    'Suchart XLPART Teilergebnis, XLWhole Exakte Suche

   With ActiveSheet.UsedRange                          'Benutzer Bereich in der Aktiven Tabelle

     

      Set rngFound = .Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=myLookAt)

      If rngFound Is Nothing Then

         MsgBox "Keine Termine vorhanden"

         Exit Sub

      End If

  

      ListBox1.Clear

      strFirstAddress = rngFound.Address(0, 0)

      Do

         ListBox1.AddItem rngFound.Text

         ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(rngFound.Row, 1).Text

         ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rngFound.Row, 2).Text

         ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(8, rngFound.Column).Text

         ListBox1.List(ListBox1.ListCount - 1, 4) = Cells(rngFound.Row - 1, rngFound.Column).Text

         Set rngFound = .FindNext(rngFound)

      Loop Until rngFound.Address(0, 0) = strFirstAddress

   End With

 End Sub

Gruß Uwe

Hallo Uwe,

Funktioniert nicht ! siehe Anhang.
hier nochmal der gesamte Code:

Code:
Option Explicit

 Private Sub CommandButton1_Click()

    Dim myLookAt As XlLookAt, strFirstAddress As String, rngFound As Range   'Suchart, Erste Adresse als Zeichenfolge, Bereich

    If Len(TextBox1.Text) = 0 Then    'Textbox leer ??

       MsgBox "Suchtext eingeben"

       Exit Sub

    End If

    myLookAt = IIf(CheckBox1.Value, xlPart, xlWhole)    'Suchart XLPART Teilergebnis, XLWhole Exakte Suche

    With ActiveSheet.UsedRange                          'Benutzer Bereich in der Aktiven Tabelle

       Set rngFound = .Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=myLookAt)

       If rngFound Is Nothing Then

          MsgBox "Keine Termine vorhanden"

          Exit Sub

       End If

       ListBox1.Clear

       strFirstAddress = rngFound.Address(0, 0)

       Do

          ListBox1.AddItem rngFound.Text

            ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(rngFound.Row, 1).Text

            ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rngFound.Row, 2).Text

            ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(8, rngFound.Column).Text

            ListBox1.List(ListBox1.ListCount - 1, 4) = Cells(rngFound.Row - 1, rngFound.Column).Text

          'ListBox1.AddItem rngFound.Address(2, 2)

          'ListBox1.AddItem rngFound.Address(-1, 0)

          'ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text

          Set rngFound = .FindNext(rngFound)

       Loop Until rngFound.Address(0, 0) = strFirstAddress

    End With

 End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    If ListBox1.ListIndex > -1 Then

    If ListBox1.Tag <> "" Then

    Range(ListBox1.Tag).Interior.ColorIndex = 0

    Cells(8, Range(ListBox1.Tag).Column).Interior.ColorIndex = 0

    Cells(Range(ListBox1.Tag).Row, 1).Interior.ColorIndex = 43

    Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 19

End If

    Range(ListBox1.Value).Select      

   ActiveCell.Interior.ColorIndex = 4

    Cells(8, ActiveCell.Column).Interior.ColorIndex = 4

    Cells(ActiveCell.Row, 1).Interior.ColorIndex = 4

    Cells(ActiveCell.Row, 2).Interior.ColorIndex = 4

    ListBox1.Tag = ActiveCell.Address

    Cancel = True

    End If

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Click()

End Sub

'Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

 ' If ListBox1.ListIndex > -1 Then

  '   If ListBox1.Tag <> "" Then Range(ListBox1.Tag).Interior.ColorIndex = 0

   '  Range(ListBox1.Value).Select

    ' ActiveCell.Interior.ColorIndex = 4

     'ListBox1.Tag = ActiveCell.Address

 '    Cancel = True

  'End If

'End Sub

 Private Sub UserForm_Initialize()

    ListBox1.ColumnCount = 2

    ListBox1.BoundColumn = 1

    ListBox1.ColumnWidths = "0,150"

 End Sub

Private Sub CommandButton2_Click()

If ListBox1.Tag <> "" Then

Range(ListBox1.Tag).Interior.ColorIndex = 0

Cells(8, Range(ListBox1.Tag).Column).Interior.ColorIndex = 0

Cells(Range(ListBox1.Tag).Row, 1).Interior.ColorIndex = 43

Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 19

End If

UserForm2.Hide

End Sub

Siehe Anhang:

Gruß Arni

Hallo Arni,

dann vielleicht so?

Private Sub CommandButton1_Click()

   Dim myLookAt As XlLookAt, strFirstAddress As String, rngFound As Range   'Suchart, Erste Adresse als Zeichenfolge, Bereich

   

   If Len(TextBox1.Text) = 0 Then    'Textbox leer ??

      MsgBox "Suchtext eingeben"

      Exit Sub

   End If

  

   myLookAt = IIf(CheckBox1.Value, xlPart, xlWhole)    'Suchart XLPART Teilergebnis, XLWhole Exakte Suche

   With ActiveSheet.UsedRange                          'Benutzer Bereich in der Aktiven Tabelle

     

      Set rngFound = .Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=myLookAt)

      If rngFound Is Nothing Then

         MsgBox "Keine Termine vorhanden"

         Exit Sub

      End If

  

      ListBox1.Clear

      strFirstAddress = rngFound.Address(0, 0)

      Do

         ListBox1.AddItem rngFound.Address(0, 0)

         ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text

         ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rngFound.Row, 1).Text

         ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(rngFound.Row, 2).Text

         ListBox1.List(ListBox1.ListCount - 1, 4) = Cells(8, rngFound.Column).Text

         ListBox1.List(ListBox1.ListCount - 1, 5) = Cells(rngFound.Row - 1, rngFound.Column).Text

         Set rngFound = .FindNext(rngFound)

      Loop Until rngFound.Address(0, 0) = strFirstAddress

   End With

 End Sub

Gruß Uwe

Hallo Uwe,

leider noch nicht.

Jetzt läuft der Code wieder wie zuvor ohne die anderen Einträge.
siehe Anhang

Gruß Arni

Hallo Arni,

schade. Aber jetzt hab ich keine Lust mehr mit Bilderrätseln.

Gruß Uwe

Hallo Uwe,

Sorry soll ich etwas anders machen ??

Gruß Arni

Hallo Uwe,

habe es hinbekommen, siehe Bild :17:

Code:
ListBox1.Clear

       strFirstAddress = rngFound.Address(0, 0)

       Do

          ListBox1.ColumnCount = 6

          ListBox1.AddItem rngFound.Address(0, 0)

            ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text

            ListBox1.AddItem rngFound.Address(-1, 0)

            ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rngFound.Row, 1).Text

            ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(rngFound.Row, 2).Text

            ListBox1.List(ListBox1.ListCount - 1, 4) = Cells(8, rngFound.Column).Text

            ListBox1.List(ListBox1.ListCount - 1, 5) = Cells(rngFound.Row - 1, rngFound.Column).Text

          'ListBox1.AddItem rngFound.Address(2, 2)

          'ListBox1.AddItem rngFound.Address(-1, 0)

          'ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text

          Set rngFound = .FindNext(rngFound)

       Loop Until rngFound.Address(0, 0) = strFirstAddress

    End With

 End Sub

Danke für deine Hilfe

Hallo Arni,

dass ColumnCount richtig eingestellt war, setzte ich nach Deinem Bild voraus. So etwas stelle ich im Editor fest ein.
Wozu Du 2 Zeilen für einen Treffer benötigst, verstehe ich nicht.
ListBox1.AddItem rngFound.Address(0, 0)
ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text
ListBox1.AddItem rngFound.Address(-1, 0)

Schau Dir auch mal die Range.Address-Eigenschaft in der Hilfe an! Wink

Gruß Uwe

Seiten: 1 2 3

Kuwer

Arni49

Kuwer

Arni49

Kuwer

Arni49

Kuwer

Arni49

Arni49

Kuwer