AW: Möglich mit Excel?
18.01.2018 11:16:21
Peter(silie)
Hallo,
wenn ich dich richtig verstehe, willst du eine Datenbank.
Hier eine kleine Datei: https://www.herber.de/bbs/user/119067.xlsm
Klicke in der Tabelle "Main_Table" auf den Button.
Wenn der Datensatz drinnen steht, dann machst du einen rechtsklick auf eine der
beiden IDs die da stehen, dann wird dir ein Fenster mit den Datensatz Daten angezeigt.
Hier nur Code:
Main_Table Worksheet Code:
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Or Target.Column = 2 Then
Cancel = True
Database.LookUp_Dataset (Cells(Target.Row, 2).Value)
End If
End Sub
Base Modul:
Public Type E_Dataset
ID As String
EmployeeID As String
End Type
Public Type Employee
ID As String
Surname As String
Firstname As String
Department As String
Location As String
Contract As String
End Type
Public Function Generated_EmployeeID() As String
Generated_EmployeeID = "Em-" & Format(Date, "yy") & Format(Time, "hhmmss") & Format(Date, " _
yyyymmdd")
End Function
Public Function Generated_DatasetID() As String
Generated_DatasetID = "Ds-" & Format(Date, "yy") & Format(Time, "hhmmss") & Format(Date, " _
yyyymmdd")
End Function
Database Modul:
Option Explicit
Public Function NewEmployee() As Dataset
Dim ds As New Dataset
ds.ID = Base.Generated_DatasetID
ds.EmployeeID = Base.Generated_EmployeeID
ds.Surname = "Mustermann"
ds.Firstname = "Max"
ds.Department = "Consulting"
ds.Location = "New York"
ds.Contract = "1937-A"
Set NewEmployee = ds
Set ds = Nothing
End Function
Public Sub AddDataset()
Dim mtbl As Worksheet, emptbl As Worksheet
Dim lastRow As Long
Dim ds As Dataset
Set ds = NewEmployee
Set mtbl = ThisWorkbook.Sheets("Main_Table")
Set emptbl = ThisWorkbook.Sheets("Emp_In_Table")
With emptbl
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = ds.EmployeeID
.Cells(lastRow, 2) = ds.Surname
.Cells(lastRow, 3) = ds.Firstname
.Cells(lastRow, 4) = ds.Department
.Cells(lastRow, 5) = ds.Location
.Cells(lastRow, 6) = ds.Contract
End With
With mtbl
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = ds.ID
.Cells(lastRow, 2) = ds.EmployeeID
End With
Set ds = Nothing
Set mtbl = Nothing
Set emptbl = Nothing
End Sub
Public Sub LookUp_Dataset(ByVal LookUpID As String)
Dim emptbl As Worksheet
Dim lastRow As Long
Dim tmp() As Variant
Set emptbl = ThisWorkbook.Sheets("Emp_In_Table")
With emptbl
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
tmp = .Range(.Cells(1, 1), .Cells(lastRow, 1)).Value2
lastRow = ReturnPosition(tmp, LookUpID)
If lastRow = 0 Then Exit Sub
frm_Display_Ds_Data.TextBox1.Value = LookUpID
frm_Display_Ds_Data.TextBox2.Value = .Cells(lastRow, 2).Value
frm_Display_Ds_Data.TextBox3.Value = .Cells(lastRow, 3).Value
frm_Display_Ds_Data.TextBox4.Value = .Cells(lastRow, 4).Value
frm_Display_Ds_Data.TextBox5.Value = .Cells(lastRow, 5).Value
frm_Display_Ds_Data.TextBox6.Value = .Cells(lastRow, 6).Value
frm_Display_Ds_Data.Show
End With
End Sub
Private Function ReturnPosition(ByRef data() As Variant, LookUpKey As String) As Long
If Not VBA.IsError(Application.Match(LookUpKey, data, 0)) Then
ReturnPosition = Application.Match(LookUpKey, data, 0)
End If
End Function
Dataset Klasse:
Option Explicit
Private ds_eds As Base.E_Dataset
Private ds_e As Base.Employee
Public Property Get ID() As String
ID = ds_eds.ID
End Property
Public Property Let ID(ByVal newID As String)
ds_eds.ID = newID
End Property
Public Property Get EmployeeID() As String
EmployeeID = ds_e.ID
End Property
Public Property Let EmployeeID(ByVal newID As String)
ds_e.ID = newID
End Property
Public Property Get Surname() As String
Surname = ds_e.Surname
End Property
Public Property Let Surname(ByVal surname_ As String)
ds_e.Surname = surname_
End Property
Public Property Get Firstname() As String
Firstname = ds_e.Firstname
End Property
Public Property Let Firstname(ByVal firstname_ As String)
ds_e.Firstname = firstname_
End Property
Public Property Get Department() As String
Department = ds_e.Department
End Property
Public Property Let Department(ByVal department_ As String)
ds_e.Department = department_
End Property
Public Property Get Location() As String
Location = ds_e.Location
End Property
Public Property Let Location(ByVal location_ As String)
ds_e.Location = location_
End Property
Public Property Get Contract() As String
Contract = ds_e.Contract
End Property
Public Property Let Contract(ByVal contract_ As String)
ds_e.Contract = contract_
End Property