Brauche eine Inputbox

Juergen · 2022-05-21T19:59:37+00:00

Hallo liebes Forum, Ich beiße mir momentan die Zähne aus und zwar geht es da rum: Ich suche eine Funktion die nach einer MsgBox eine Inputbox Öffnet mit zusätzlicher Auswahl,diese Auswahl soll dann in einer Nachbarzelle hinein kopiert werden. Anbei eine Beispielmappe: Ich hoffe der Link ist rechtens :Ein Upload war mir hier nicht möglich https://docs.google.com/spreadsheets/d/10zux3IlsWKBvYVFP1VoH9-ow9Uhd9wFk/edit?usp=sharing&ouid=101489644661233412889&rtpof=true&sd=true Ein ganz großen Dank schon mal im vorraus

Hallo Juergen,
Dann probiers mal damit: Doppelklick in "Mitgliederübersicht" kopiert das ausgewählte Mitglied nach "Uebersicht" in die erste freie Zelle in Spalte "I".
Dann Doppelklick auf ein Mitglied in Spalte I. Es öffnet sich eine Userform mit den in der "Mitgliederübersicht" in Spalte H vorhandenen "Helfer". Ein Klick auf einen der Namen überträgt diesen in die Spalte E in "Uebersicht", bei dem in I angeklickten Mitglied. Gleichzeitig wird das aktuelle Datum und Uhrzeit in die Spalten C & D eingetragen.
Falls ein in Spalte I ausgewählter Mitgliedsname in Spalte E nicht vorhanden ist, wirst du gefragt, ob dieser hinzugefügt werden soll. Bei ja, wird er hinzugefügt und alle anderen Daten ebenfalls.
https://www.herber.de/bbs/user/153237.xlsm
Servus

Dann probiers mal damit:
https://www.herber.de/bbs/user/153265.xlsm
In Classmodule "Uebersicht":


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x&
If Not Intersect(Target, Range("rng_Teilnehmer")) Is Nothing Then
If Range("I28")  "" Then
MsgBox "Formular ist voll!"
Exit Sub
End If
sMitglied = Target.Value
lRowIn = Cells(Rows.Count, "E").End(xlUp).Row + 1
UF_Helfer.Show
End If
ActiveCell.Offset(1, 0).Select
End Sub

In Classmodule "Mitgliederübersicht":


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x&, lRowIn&
If Not Intersect(Target, Range("rng_Mitgliederliste")) Is Nothing Then
With Sheets("Uebersicht")
If .Range("I28")  "" Then
MsgBox "Formular ist voll!"
Exit Sub
End If
sMitglied = Target.Value
lRowIn = .Cells(Rows.Count, "I").End(xlUp).Row + 1
.Cells(lRowIn, "I").Value = sMitglied
End With
MsgBox Target & " wurde eingetragen", vbInformation, "Datenübertrag ..."
End If
Sheets("Uebersicht").Select
End Sub

Und in der UserForm:


Private Sub ListBox_Helfer_Click()
Dim lCol&
lCol = Range("1:10").Find(What:="Start Helfer").Column
Cells(lRowIn, 3).Value = Date
Cells(lRowIn, 4).Value = Time
Cells(lRowIn, 5).Value = sMitglied
Cells(lRowIn, lCol).Value = ListBox_Helfer.Text
Unload Me
End Sub

Servus

Forumthread: Brauche eine Inputbox

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Brauche eine Inputbox

Forumthread: Brauche eine Inputbox

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread