Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 16.12.2016
Version(en): 2013
Hallo Uwe,
habe Dir ein Bild angehangen.
Gruß Arni
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 16.12.2016
Version(en): 2013
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 16.12.2016
Version(en): 2013
Hallo Uwe,
leider noch nicht.
Jetzt läuft der Code wieder wie zuvor ohne die anderen Einträge.
siehe Anhang
Gruß Arni
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Arni,
schade. Aber jetzt hab ich keine Lust mehr mit Bilderrätseln.
Gruß Uwe
Registriert seit: 16.12.2016
Version(en): 2013
Hallo Uwe,
Sorry soll ich etwas anders machen ??
Gruß Arni
Registriert seit: 16.12.2016
Version(en): 2013
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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!  Gruß Uwe
|
