da Dir meine Variablen Deklaration nicht so gefiel, weil ich teilweise die Variablen unterschiedlich nutzte, habe ich jetzt etwas "sprechendere" Definitionen genutzt.
Außerdem ist der Code relativ flexible und gut anpassbar. Ich Denke mitlerweile bist Du auch schon soweit, dass Du den Code auch ohne Kommentare verstehen würdest.
Ich weiß nicht, wie intensiv Du den Code getestet hast, aber ich hab festgestellt, dass es unter bestimmten Gegebenheiten zu Fehlern kommt.
Das und Dein "Verständniswille" bezüglich des Codes ist ein Grund, warum ich den Code verändert habe. Bei der Gelegenheit konnte ich ihn noch einmal zusammenstutzen.
Code:
Option Explicit
Private Const WerteSpalte = 8 'hier ist festgelegt, in welcher Spalte die werte stehen (Bei Bedarf nur die Zahl für die Spalte anpassen)
Private Const EintragSpalte = 9 'hier wird die Spalte angegeben, in welche geschrieben wird
Private Sub CommandButton1_Click()
löschen
End Sub
Private Sub CommandButton2_Click()
löschen
End Sub
Private Sub CommandButton3_Click()
löschen
End Sub
Private Sub CommandButton4_Click()
löschen
End Sub
Private Sub CommandButton5_Click()
löschen
End Sub
Private Sub CommandButton6_Click()
löschen
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.ListCount Then 'wenn Anzahl Einträge in listbox1 dann
listbox_füllen
' DoEvents 'Übergibt die Steuerung an das Betriebssystem, damit es andere Ereignisse verarbeiten kann
If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1 'wenn Einträge in der listbox dann Listindex auf -1 -> damit keine Auswahl
Application.Wait (Time + TimeValue("00:00:01")) 'Codeausführung für 1 sec anhalten
If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1
End If
End Sub
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'bei Doppelklick auf die Userform
UserForm_Initialize 'Userform wird neu geladen; alles was beim ersten Laden passierte, wird erneut ausgeführt.
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim EintragLetzteZeile As Long
Dim ListeSpaltenLetzteZeile As Long, WerteLetzteZeile As Long
ListeSpaltenLetzteZeile = Cells(Rows.Count, 1).End(xlUp).Row 'letzte belegte Zelle Spalte A
WerteLetzteZeile = Cells(Rows.Count, WerteSpalte).End(xlUp).Row 'letzte belegte Zelle Spalte H
EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1 'erste freie Zelle in Spalte I
Range(Cells(2, EintragSpalte), Cells(EintragLetzteZeile, EintragSpalte)).ClearContents
' Range("I2:I" & Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1).ClearContents 'I2 bis letzte belegte Zelle Inhalte löschen
If WerteLetzteZeile < 2 Then 'wenn Spalte H weniger als zwei Einträge
MsgBox "Keine Auswahl eingetragen!"
Exit Sub
End If
ListBox1.List = Range(Cells(2, 1), Cells(ListeSpaltenLetzteZeile, 1)).Value 'Listbox1 aus Spalte A füllen
Frame1.Caption = Range("A1") 'Frame1 beschriften mit Überschrift aus Spalte A
For i = 2 To WerteLetzteZeile 'Frames 2 bis soviele Einträge wie in Spalte H mit den Werten aus Spalte H beschriften
Me.Controls("Frame" & i).Caption = Cells(i, WerteSpalte)
Next i
For i = 1 To WerteLetzteZeile - 1 'In die Tag Eigenschaft der Schaltflächen den Wert von i reinschreiben
Me.Controls("CommandButton" & i).Tag = i
Next i
Me.Tag = 2 'Userform Tag wird der wert 2 eingetragen, Dieser Wert wird bei Doppelklick in die Listbox abgefragt und ist dann die Schreibzeile
Me.ListBox2.ListIndex = 0
End Sub
Sub löschen() 'wird bei Clear Schaltflächen ausgeführt
Dim i As Long, j As Long
Dim EintragLetzteZeile As Long, ListeSpaltenLetzteZeile As Long
EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row 'Letzte belegte Zelle in Spalte EintragSpalte
j = ActiveControl.Tag 'der Wert in der Tag Eigennschaft der aufrufenden Schaltfläche wird an Variable j übergeben
Me.Tag = j + 1 'Der glkeiche Wert wird in die Tag Eigenschaft der Userform geschrieben
If j < EintragLetzteZeile Then 'Wenn Userfoerm Tag = 0 und j (Schaltflächenindex) < letzte belegte Zeile in Spalte I
ListeSpaltenLetzteZeile = Cells(Rows.Count, j).End(xlUp).Row 'Letzte belegte Zelle in Spalte j=Schaltflächenindex
Cells(j + 1, EintragSpalte) = "" 'Zelleninhalt leeren
ListBox1.List = Range(Cells(2, j), Cells(ListeSpaltenLetzteZeile, j)).Value 'Bereich aus Spalte j=Schaltflächenindex und letzten Zelle aus Spalte j=Schaltflächenindex in listbox1 einlesen
Me.Frame1.Caption = Cells(j + 1, WerteSpalte).Value 'Frame1 neu beschriften mit der Überschrift der eingelesenen Spalte
Me.Controls("Listbox" & j + 1).BackColor = RGB(500, 0, 0) 'Listbox mit dem Index der aufrufenden Schaltfläche +1 roter Hintergrund
Me.Controls("Listbox" & EintragLetzteZeile + 1).ListIndex = -1 'Listindex der vorher ausgewählten Listbox auf -1 setzen um die Markierung wegzunehmen
Me.Frame1.SetFocus
End If
End Sub
Sub listbox_füllen()
Dim i As Long, j As Long, lngAnzahl As Long
Dim WerteLetzteZeile As Long, EintragLetzteZeile As Long, FreieZelleZeile As Long, ListeSpaltenLetzteZeile As Long
WerteLetzteZeile = Cells(Rows.Count, WerteSpalte).End(xlUp).Row 'letzte belegte Zelle in Spalte H
EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1 'erste freie Zelle in Spalte I
FreieZelleZeile = Range(Cells(2, EintragSpalte), Cells(EintragLetzteZeile, EintragSpalte)).SpecialCells(xlCellTypeBlanks).Row
If FreieZelleZeile <= WerteLetzteZeile Then
Cells(Me.Tag, EintragSpalte) = Me.ListBox1
EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1 'erste freie Zelle in Spalte I
FreieZelleZeile = Range(Cells(2, EintragSpalte), Cells(EintragLetzteZeile, EintragSpalte)).SpecialCells(xlCellTypeBlanks).Row
If FreieZelleZeile < WerteLetzteZeile + 1 Then
Me.Controls("Listbox" & Me.Tag).BackColor = &H8000000F
ListeSpaltenLetzteZeile = Cells(Rows.Count, FreieZelleZeile - 1).End(xlUp).Row
Me.ListBox1.List = Range(Cells(2, FreieZelleZeile - 1), Cells(ListeSpaltenLetzteZeile, EintragLetzteZeile)).Value
Me.Controls("Listbox" & FreieZelleZeile).ListIndex = 0
Me.Frame1.Caption = Cells(FreieZelleZeile, WerteSpalte)
Me.Tag = FreieZelleZeile
Else
Me.ListBox1.Clear
Me.Controls("Listbox" & Me.Tag).ListIndex = -1
Me.Controls("Listbox" & Me.Tag).BackColor = &H8000000F
Me.Frame1.Caption = ""
End If
End If
End Sub