Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Suchen und Markieren

Thema geschlossen 
Baumstrukturmodus
Suchen und Markieren
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#11
27.12.2016, 13:58
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
Suchen
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#12
27.12.2016, 14:48
Hallo Uwe,

habe Dir ein Bild angehangen.

Gruß Arni
Suchen
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#13
27.12.2016, 16:12
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
Suchen
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#14
27.12.2016, 16:50
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
Suchen
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#15
27.12.2016, 17:01
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
Suchen
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#16
27.12.2016, 17:28
Hallo Uwe,

leider noch nicht.

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

Gruß Arni
Suchen
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#17
27.12.2016, 17:36
Hallo Arni,

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

Gruß Uwe
Suchen
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#18
27.12.2016, 17:39
Hallo Uwe,

Sorry soll ich etwas anders machen ??

Gruß Arni
Suchen
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#19
27.12.2016, 18:05
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
Suchen
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#20
28.12.2016, 01:43
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
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste