AW: Daten aus anderem Blatt auf userform
08.02.2016 16:48:41
ChrisL
Hi Rolf
Hier...
Option Explicit
Dim rngFind As Range
Dim rngID As Range
Dim Bol As Boolean
Private Sub CommandButton3_Click()
Dim letzte_Zeile As Long
With Worksheets("Daten")
' Datensatz neu speichern
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = .Cells(letzte_Zeile - 1, 1) + 1
.Cells(letzte_Zeile, 2) = TextBox1.Text
.Cells(letzte_Zeile, 3) = ComboBox1.Text
.Cells(letzte_Zeile, 4) = TextBox2
.Cells(letzte_Zeile, 5) = TextBox3.Text
.Cells(letzte_Zeile, 6) = TextBox4.Text
.Cells(letzte_Zeile, 7) = TextBox5.Text
.Cells(letzte_Zeile, 8) = TextBox6.Text
.Cells(letzte_Zeile, 13) = TextBox7.Text
End With
ClearAll
UserForm_Initialize
ComboBox1.SetFocus
End Sub
Private Sub CommandButton5_Click()
If ComboBox1.Text = "" Then
'UserForm schließen
Bol = False
Unload UserForm1
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Bol = False
Unload UserForm1
End If
End Sub
Private Sub CommandButton2_Click()
' Datensatz ändern
If Not rngID Is Nothing Then
'rngID.Value = ComboBox1.Text
rngID.Offset(0, 1).Value = TextBox1.Text
rngID.Offset(0, 3).Value = TextBox2.Text
rngID.Offset(0, 4).Value = TextBox3.Text
rngID.Offset(0, 5).Value = TextBox4.Text
rngID.Offset(0, 6).Value = TextBox5.Text
rngID.Offset(0, 7).Value = TextBox6.Text
rngID.Offset(0, 12).Value = TextBox7.Text
Else
rngFind.Value = ComboBox1.Text
rngFind.Offset(0, -1).Value = TextBox1.Text
rngFind.Offset(0, 1).Value = TextBox2.Text
rngFind.Offset(0, 2).Value = TextBox3.Text
rngFind.Offset(0, 3).Value = TextBox4.Text
rngFind.Offset(0, 4).Value = TextBox5.Text
rngFind.Offset(0, 5).Value = TextBox6.Text
rngFind.Offset(0, 10).Value = TextBox7.Text
End If
ClearAll
UserForm_Initialize
ComboBox1.SetFocus
End Sub
Private Sub CommandButton4_Click()
Dim a As Integer
Dim msg
Dim letzte_Zeile As Long
'Datensatz löschen
With Worksheets("Daten")
letzte_Zeile = .Range("A65536").End(xlUp).Row
If Not rngID Is Nothing Then
a = rngID + 1
Else
a = .Range(rngFind.Address).Row
End If
If MsgBox(" Datensatz wirklich löschen ?", vbYesNo) = vbNo Then
Exit Sub
Else
.Range(.Cells(a, "B"), .Cells(a, "M")).Delete shift:=xlShiftUp
.Cells(letzte_Zeile, "A").ClearContents
End If
ClearAll
UserForm_Initialize
ComboBox1.SetFocus
End With
End Sub
Private Sub CommandButton1_Click()
Dim sSearch As String
Dim firstAddress
Dim i As Integer
'Datensatz suchen
If ComboBox1.Text = "" Then
MsgBox "Geben Sie bitte einen Suchbegriff ein !"
Exit Sub
Else
sSearch = ComboBox1.Text
Set rngFind = Worksheets("Daten").Columns("C:C").Find(what:=sSearch, lookat:=xlWhole, LookIn:= _
xlValues)
If rngFind Is Nothing Then
If MsgBox("Dieser Datensatz existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie ihn _
jetzt neu anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
ComboBox1.Text = ""
ComboBox1.SetFocus
Exit Sub
Else
ComboBox1.SetFocus
End If
Else
i = 0
firstAddress = rngFind.Address
Do
ListBox1.AddItem
ListBox1.List(i, 0) = rngFind.Offset(0, -2).Value
ListBox1.List(i, 1) = rngFind.Offset(0, -1).Value
ListBox1.List(i, 2) = rngFind
ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
ListBox1.List(i, 4) = rngFind.Offset(0, 2).Value
ListBox1.List(i, 5) = rngFind.Offset(0, 3).Value
ListBox1.List(i, 6) = rngFind.Offset(0, 4).Value
Set rngFind = Worksheets("Daten").Columns("C:C").FindNext(rngFind)
i = i + 1
Loop While Not rngFind Is Nothing And rngFind.Address firstAddress
End If
End If
If ListBox1.ListCount = 1 Then
TextBox1.Text = rngFind.Offset(0, -1).Value
TextBox2.Text = rngFind.Offset(0, 1).Value
TextBox3.Text = rngFind.Offset(0, 2).Value
TextBox4.Text = rngFind.Offset(0, 3).Value
TextBox5.Text = rngFind.Offset(0, 4).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 10).Value
ListBox1.Clear
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sSearch As String
If ListBox1.ListCount > 1 Then
sSearch = ListBox1.List(ListBox1.ListIndex, 0)
Set rngID = Worksheets("Daten").Columns("A:A").Find(what:=sSearch, lookat:=xlWhole, LookIn:= _
xlValues)
If Not rngID Is Nothing Then
TextBox1.Text = rngID.Offset(0, 1).Value
TextBox2.Text = rngID.Offset(0, 3).Value
TextBox3.Text = rngID.Offset(0, 4).Value
TextBox4.Text = rngID.Offset(0, 5).Value
TextBox5.Text = rngID.Offset(0, 6).Value
TextBox6.Text = rngID.Offset(0, 7).Value
TextBox7.Text = rngID.Offset(0, 12).Value
TextBox8.Text = rngID.Offset(0, 0).Value
End If
sSearch = ""
End If
ListBox1.Clear
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Fehlermeldung, wenn versucht wird, die UserForm über das
'Schließenkreuz oben rechts zu schließen
If CloseMode = 0 Then
' MsgBox "Bitte verlassen Sie die Eingabemaske nur mit der Schaltfläche - Beenden.", _
' vbOKOnly + vbInformation, "Bitte Schaltfläche betätigen."
Cancel = 1
End If
End Sub
Public Sub UserForm_Initialize()
Dim a As Integer
Dim az As Integer ' Zähler für Arrayfelder
Dim i As Integer ' Schleifenzähler (Arrays füllen)
Dim arr() As Variant ' Array für Datenausgabe
a = Sheets("Daten").Range("A65536").End(xlUp).Row
' Array dimensionieren
ReDim arr(a, 0) ' Feld nach Listenlänge festlegen
' Arrays mit Werten füllen
For i = 2 To UBound(arr) ' laufe von Zeile 2 bis _
Tabellenende
If Application.WorksheetFunction.CountIf(Worksheets("Daten").Range(Worksheets("Daten"). _
Cells(i, 1), Worksheets("Daten").Cells(1, 3)), Worksheets("Daten").Cells(i, 3).Value) = 1 Then ' wenn Wert das erste Mal vorkommt, dann ...
arr(az, 0) = Worksheets("Daten").Cells(i, 3).Value ' .. _
. Name in Array einlesen
az = az + 1 ' ... Zähler für _
Arrayfeld plus 1
End If ' Ende der Auswertung
Next i
ComboBox1.List = arr
End Sub
Private Sub UserForm_Activate()
'Datum und Uhrzeit anzeigen
Label9.Caption = Date
Bol = True
Do Until Bol = False
DoEvents
Label10.Caption = Time
Loop
End Sub
Sub ClearAll()
Dim C As Integer
On Error Resume Next
ComboBox1.Text = ""
For C = 1 To 7
Me.Controls("TextBox" & CStr(C)).Text = ""
Next C
End Sub