AW: Tabelle über Variable wählen
16.12.2020 13:29:00
Nepumuk
Hallo Chris,
ich war mal so frei den gröbsten Unsinn auszumerzen:
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************
Option Explicit
Option Compare Text
Private mobjWorksheet As Worksheet
Private Sub ComboBox1_Change()
Set mobjWorksheet = Worksheets("data" & ComboBox1.Text)
End Sub
'NeuerDatensatz Schaltfläche Ereignisroutine
Private Sub NeuerDatensatz_Click()
Dim lZeile As Long
'Wenn der Benutzer einen neuen Eintrag erzeugen möchte,
'erstellen wir einen neuen Eintrag in der ListBox und markieren
'diesen, damit der Benutzer die Daten eintragen kann
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
With mobjWorksheet
lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von mobjWorksheet
'Neuen Eintrag in die mobjWorksheet schreiben, Spalte MAName muss gefüllt sein, damit
'unsere Routinen die Zeile wiederfinden!
mobjWorksheet.Cells(lZeile, 1) = "Neuer Eintrag"
'Und neuen Eintrag in die UserForm eintragen
ListeMA.AddItem "Neuer Eintrag"
'Den neuen Eintrag markieren mit Hilfe des ListIndexes
ListeMA.ListIndex = ListeMA.ListCount - 1
'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub Loeschen_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListeMA.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
With mobjWorksheet
For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Datensatz MAName Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListeMA.Text = .Cells(lZeile, 1).Text Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
.Rows(CStr(lZeile & ":" & lZeile)).Delete
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListeMA.ListCount > 0 Then ListeMA.ListIndex = 0
Exit For 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
Next
End With
End Sub
'Speichern Schaltfläche Ereignisroutine
Private Sub Speichern_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListeMA.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die MAName Spalte auch gefüllt ist!!
If Trim(CStr(MAName.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
'Ausbauoption: Prüfen, ob die MAName in mobjWorksheet Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
With mobjWorksheet
For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Datensatz MAName Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListeMA.Text = .Cells(lZeile, 1).Text Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
.Cells(lZeile, 1).Value = Trim(CStr(MAName.Text))
.Cells(lZeile, 2).Value = arbeitetals.Text
.Cells(lZeile, 3).Value = arbeitetseit.Text
.Cells(lZeile, 4).Value = kom1.Text
.Cells(lZeile, 5).Value = kom2.Text
.Cells(lZeile, 6).Value = kom3.Text
.Cells(lZeile, 7).Value = kom4.Text
.Cells(lZeile, 8).Value = kom5.Text
.Cells(lZeile, 9).Value = kom6.Text
.Cells(lZeile, 10).Value = kom7.Text
.Cells(lZeile, 11).Value = kom8.Text
.Cells(lZeile, 12).Value = kom9.Text
.Cells(lZeile, 13).Value = kom10.Text
.Cells(lZeile, 14).Value = kom11.Text
.Cells(lZeile, 15).Value = kom12.Text
.Cells(lZeile, 16).Value = kom13.Text
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name (MAName) geändert hat
If ListeMA.Text <> MAName.Text Then
Call UserForm_Initialize
If ListeMA.ListCount > 0 Then ListeMA.ListIndex = 0
End If
Exit For 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
Next
End With
Dim intAnz As Integer
Dim lngRow As Long
lngRow = Application.Match(MAName.Text, mobjWorksheet.Columns(1), 0)
For intAnz = 17 To 148
mobjWorksheet.Cells(lngRow, intAnz) = Controls("OptionButton" & intAnz - 16)
Next intAnz
Prozent = Auswertung.Cells(ListeMA.ListIndex + 2, 8)
Euro = Auswertung.Cells(ListeMA.ListIndex + 2, 9)
End Sub
'Beenden Schaltfläche Ereignisroutine
Private Sub Beenden_Click()
Unload Me
'ActiveWorkbook.Close
End Sub
'Klick auf die ListBox Ereignisroutine
Private Sub ListeMA_Click()
Dim lZeile As Long
Dim lngRow As Long
Dim intAnz As Integer
' ##########################################################################
' Daten der Optionsschaltflächen auslesen und im UserForm anzeigen
lngRow = Application.Match(ListeMA.Text, mobjWorksheet.Columns(1), 0)
For intAnz = 17 To 148
Controls("OptionButton" & intAnz - 16) = mobjWorksheet.Cells(lngRow, intAnz)
Next intAnz
' ##########################################################################
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der mobjWorksheet heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
MAName = ""
arbeitetals = ""
arbeitetseit = ""
kom1 = ""
kom2 = ""
kom3 = ""
kom4 = ""
kom5 = ""
kom6 = ""
kom7 = ""
kom8 = ""
kom9 = ""
kom10 = ""
kom11 = ""
kom12 = ""
kom13 = ""
Prozent = ""
Euro = ""
'Nur wenn ein Eintrag selektiert/markiert ist
If ListeMA.ListIndex >= 0 Then
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
With mobjWorksheet
For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Wenn wir den Namen aus der ListeMA in der mobjWorksheet Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListeMA.Text = .Cells(lZeile, 1).Text Then
'TextBoxen füllen
MAName = .Cells(lZeile, 1).Value
arbeitetals = .Cells(lZeile, 2).Value
arbeitetseit = .Cells(lZeile, 3).Value
kom1 = .Cells(lZeile, 4).Value
kom2 = .Cells(lZeile, 5).Value
kom3 = .Cells(lZeile, 6).Value
kom4 = .Cells(lZeile, 7).Value
kom5 = .Cells(lZeile, 8).Value
kom6 = .Cells(lZeile, 9).Value
kom7 = .Cells(lZeile, 10).Value
kom8 = .Cells(lZeile, 11).Value
kom9 = .Cells(lZeile, 12).Value
kom10 = .Cells(lZeile, 13).Value
kom11 = .Cells(lZeile, 14).Value
kom12 = .Cells(lZeile, 15).Value
kom13 = .Cells(lZeile, 16).Value
Prozent = Auswertung.Cells(lZeile, 8).Value
Euro = Auswertung.Cells(lZeile, 9).Value
Exit For 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
Next
End With
End If
End Sub
Private Sub UserForm_Activate()
'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
'jedoch nur, wenn auch Einträge in der Liste stehen
If ListeMA.ListCount > 0 Then ListeMA.ListIndex = 0
End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
MAName = ""
arbeitetals = ""
arbeitetseit = ""
kom1 = ""
kom2 = ""
kom3 = ""
kom4 = ""
kom5 = ""
kom6 = ""
kom7 = ""
kom8 = ""
kom9 = ""
kom10 = ""
kom11 = ""
kom12 = ""
kom13 = ""
Prozent = ""
Euro = ""
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListeMA
ListeMA.Clear 'Zuerst einmal die Liste leeren
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
With Me.ComboBox1
.AddItem "2020"
.AddItem "2021"
.ListIndex = 0 'Vorbelegung
End With
With mobjWorksheet
'Aktuelle Zeile in die ListBox eintragen
ListeMA.List = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
Call sortieren(0, ListeMA.ListCount - 1)
Speichern.Accelerator = "s"
End Sub
'
'Sortieren ListBox
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long)
Dim index1 As Long, index2 As Long, Element As String, Zwischenspeicher As String
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = ListeMA.List(((Untergrenze + Obergrenze) / 2) \ 1)
Do
Do While ListeMA.List(index1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < ListeMA.List(index2)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element = ListeMA.List(index1)
ListeMA.List(index1) = ListeMA.List(index2)
ListeMA.List(index2) = Element
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze)
End Sub
Public Sub MADruck_click()
DruckMA.Cells(3, 8).Value = ""
DruckMA.Cells(3, 16).Value = ""
DruckMA.Cells(3, 28).Value = ""
DruckMA.Cells(3, 1).Value = ""
DruckMA.Cells(3, 22).Value = ""
DruckMA.Cells(3, 27).Value = ""
DruckMA.Cells(5, 4).Value = MAName.Text
DruckMA.Cells(5, 17).Value = arbeitetals.Text
DruckMA.Cells(5, 31).Value = arbeitetseit.Text
If arbeitetals.Value = "Kommissionierer" Or arbeitetals.Value = "TL Kommissionierer" Then
DruckMA.Cells(3, 8).Value = "X"
ElseIf arbeitetals.Value = "Packer" Or arbeitetals.Value = "TL Packen" Then
DruckMA.Cells(3, 16).Value = "X"
ElseIf arbeitetals.Value = "Versand" Or arbeitetals.Value = "Versandleiter" Or arbeitetals.Value = "stellv. Versandleiter" Then
DruckMA.Cells(3, 28).Value = "X"
ElseIf arbeitetals.Value = "Wareneingang" Or arbeitetals.Value = "Wareneingangsleiter" Or arbeitetals.Value = "stellv. Wareneingansleiter" Then
DruckMA.Cells(3, 1).Value = "X"
ElseIf arbeitetals.Value = "Heimarbeit" Or arbeitetals.Value = "Heimarbeitsleiter" Then
DruckMA.Cells(3, 22).Value = "X"
ElseIf arbeitetals.Value = "Leitstand" Or arbeitetals.Value = "stellv. Lagerleiter" Then
DruckMA.Cells(3, 27).Value = "X"
End If
End Sub
Private Sub LSDruck_Click()
DruckLS.Cells(3, 8).Value = ""
DruckLS.Cells(3, 16).Value = ""
DruckLS.Cells(3, 28).Value = ""
DruckLS.Cells(3, 1).Value = ""
DruckLS.Cells(3, 22).Value = ""
DruckLS.Cells(3, 27).Value = ""
DruckLS.Cells(5, 4).Value = MAName.Text
DruckLS.Cells(5, 17).Value = arbeitetals.Text
DruckLS.Cells(5, 31).Value = arbeitetseit.Text
If arbeitetals.Value = "Kommissionierer" Or arbeitetals.Value = "TL Kommissionierer" Then
DruckLS.Cells(3, 8).Value = "X"
ElseIf arbeitetals.Value = "Packer" Or arbeitetals.Value = "TL Packen" Then
DruckLS.Cells(3, 16).Value = "X"
ElseIf arbeitetals.Value = "Versand" Or arbeitetals.Value = "Versandleiter" Or arbeitetals.Value = "stellv. Versandleiter" Then
DruckLS.Cells(3, 28).Value = "X"
ElseIf arbeitetals.Value = "Wareneingang" Or arbeitetals.Value = "Wareneingangsleiter" Or arbeitetals.Value = "stellv. Wareneingansleiter" Then
DruckLS.Cells(3, 1).Value = "X"
ElseIf arbeitetals.Value = "Heimarbeit" Or arbeitetals.Value = "Heimarbeitsleiter" Then
DruckLS.Cells(3, 22).Value = "X"
ElseIf arbeitetals.Value = "Leitstand" Or arbeitetals.Value = "stellv. Lagerleiter" Then
DruckLS.Cells(3, 27).Value = "X"
End If
End Sub
Gruß
Nepumuk