858 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Spezialisten,
ich habe mir 2 Tabellen gebastelt, Facebook und Facebook_Tiere.
In "Facebook.xlsm" sind im Blatt "Index" alle meine Tiere aufgelistet.
In "Facebook_Tiere.xlsm" sind im Blatt "Gesamt" alle existierende Tiere aufgelistet.
Nun habe ich mir eine USERFORM aus Beiträgen im Internet versucht zusammen zu basteln.
Leider ohne Erfolg.
Die Userform wird im Blatt "Facebook!Index" aufgerufen. Nun soll, wenn in der "TEXTBOX1"
ein Tiername eingegeben wird, die Tiernamen aus "Facebook_Tiere!Gesamt" in der "Listbox"
angezeigt werden.
Wenn der Name in der "Listbox" per Doppelklick aktiviert wird, soll dieser in die letzte freie
Zeile in die Spalte 3 in "Facebook!Index" geschrieben werden. Hier ist einer meiner zahllosen
Tests.


Option Explicit

Dim x As Long
Dim FaName As String
Dim erste_freie_Zeile As Integer


Private Sub CommandButton1_Click()
FaName = ""
Unload Me
End Sub

Private Sub CommandButton2_Click()
Dim erste_freie_Zeile As Integer
erste_freie_Zeile = Sheets("Index").Range("c65536").End(xlUp).Offset(0, 0).ClearContents
Unload Me
End Sub

Private Sub CommandButton5_Click()
Unload Me
UserForm3.Show
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FaName = ListBox1.Value
erste_freie_Zeile = Sheets("Index").Range("c65536").End(xlUp).Offset(1, 0).Row
Sheets("Index").Cells(erste_freie_Zeile, 3) = ListBox1.Text = FaName
End Sub

Private Sub TextBox1_Change()
Dim erste_freie_Zeile As Integer
Dim arr() As Variant
Dim index As Long, iCount As Long
x = IIf(IsEmpty(Range("a65536")), Range("a65536").End(xlUp).Row, 65536)
If TextBox1.Value = "" Then
Windows("Facebook_Tiere.xlsm").Activate
Sheets("Gesamt").Select
ListBox1.RowSource = "a9:a" & x
Exit Sub
End If
ListBox1.RowSource = ""
ListBox1.Clear
Windows("Facebook_Tiere.xlsm").Activate
Sheets("Gesamt").Select
For index = 5 To x
If LCase(Left(Cells(index, 3), Len(TextBox1))) = LCase(TextBox1) Then
Windows("Facebook_Tiere.xlsm").Activate
Sheets("Gesamt").Select
If Sheets("Gesamt").Cells(index, 3) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 3)
iCount = iCount + 1
ListBox1.Column = arr
End If
End If
Next
End Sub

Private Sub UserForm_Initialize()
x = IIf(IsEmpty(Range("a65536")), Range("a65536").End(xlUp).Row, 65536)
Windows("Facebook_Tiere.xlsm").Activate
Sheets("Gesamt").Select
ListBox1.RowSource = "a9:a" & x
End Sub

Irgendwo steckt ein Fehler, nur wo.
Ich muss gestehen, ich habe keine Ahnung von VBA, habt ihr bestimmt auch schon bemerkt.
Falls mir jemand helfen kann, wäre es für mich wichtig, die Änderungen zu makieren, damit
ich meine Fehler finden kann.

Vielen Dank

Karlheinz

PS: Falls ich mich undeutlich ausgedrückt habe, oder etwaige Fragen sind,
stehe ich natürlich gerne zur Verfügung.

Deine Antwort

Dein angezeigter Name (optional):
Datenschutz: Deine Email-Adresse benutzen wir ausschließlich, um dir Benachrichtigungen zu schicken. Es gilt unsere Datenschutzerklärung.
Anti-Spam-Captcha:
Bitte logge dich ein oder melde dich neu an, um das Anti-Spam-Captcha zu vermeiden.
...