UserForm - Ausgabe eines Spaltentitels in Textbox
14.10.2006 05:47:26
Sven
ich probiere nun schon 2 Stunden einen Volltext-Suchcode für mich anzupassen und es klappt einfach nicht.
Kurze Beschreibung:
Nach einer Suche in einer UserForm sollen unter anderem in einem Listfeld pro Zeile 5 Zellen angezeigt werden. Grundcode ist von IVAN hier aus dem Forum, diesen habe ich leicht modifiziert.
Was klappt sind die 4 Informationen die die Suche auswirft, anzuzeigen (sie stehen in einer Zeile, wobei eine den Suchbegriff enthält).
Was nicht klappt: Zusätzlich möchte ich als 5. Information den Spaltentitel einfügen, unter dem der Suchbegriff gefunden wurde.
Es gibt 15 Spaltentitel, beginnend mit B6, dann C6, D6 ...
Diese nennen sich "Titel", "Bestell-Nr.", "Jahr" ...
Hier mal der fehlerhafte Code:
Private Sub cmdSuche_Click()
Dim s As String
Dim Found As Range
Dim FirstAddress As String
Dim i As Integer ' Zeile
Dim f As Integer ' Fehlende
i = 0
f = 0
If txtSuche.Text = "" Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Was soll ich den suchen?"
txtSuche.SetFocus
Else
End If
Eingabe = txtSuche.Text
If Eingabe = "" Then Exit Sub
ListBox1.Clear
ListBox2.Clear
With ActiveSheet
Set Found = .Cells.Find(Eingabe, LookAt:=xlPart)
If Not Found Is Nothing Then
FirstAddress = Found.Address
ListBox1.ColumnCount = 5
ListBox1.AddItem Found
If Cells(Found.Row, 7) = "F" Then
ListBox1.List(i, 1) = Cells(Found.Row, 7)
f = f + 1
Else
End If
ListBox1.List(i, 2) = Cells(Found.Row, 13)
ListBox1.List(i, 3) = Cells(Found.Row, 2)
ListBox1.List(i, 4) = Cells(Found.Column, 6) '<----- Hier das Problem!
ListBox2.AddItem Found.Row
i = i + 1
Do
Found.Activate
Set Found = Cells.FindNext(After:=ActiveCell)
On Error Resume Next
If Found.Address = FirstAddress Then Exit Do
ListBox1.AddItem Found
If Cells(Found.Row, 7) = "F" Then
ListBox1.List(i, 1) = Cells(Found.Row, 7)
f = f + 1
Else
End If
ListBox1.List(i, 2) = Cells(Found.Row, 13)
ListBox1.List(i, 3) = Cells(Found.Row, 2)
ListBox1.List(i, 4) = Cells(Found.Column, 6) ' <----- Hier das Problem
ListBox2.AddItem Found.Row
i = i + 1
txtAnzahl = i
txtBestandZ = i - f
txtFehlendeZ = f
Loop
End If
End With
cmdSuche.Caption = "Neue Suche"
CmdAbbruch.Caption = "OK"
i = 0
f = 0
End Sub
Ich hoffe jemand kann mir folgen. Es muss sich nur um eine Kleinigkleit handeln, aber ich finde die Lösung einfach nicht.