Bearbeitung Arbeitsblatt simpler
18.09.2022 22:03:14
Alexander
Wie Ihr seht ist mein Code sehr lange und wollte mal die Profis von euch fragen ob es einfacher auch geht das anlegen geht auch noch nicht wirklich
Wäre zu Dank verpflichtet wenn Ihr eine Lösung für mein Problem hättet
Lg Alex
Option Explicit
Const ws_DB As String = "DB"
Const ws_Eingabe As String = "Trocknung"
Sub TrocknungBearbeiten_DBEingabe()
Call ws_Unprotect(ws_DB, ws_Eingabe)
Dim tbl As ListObject
Set tbl = WbDB.ListObjects(1)
Dim Zeile As Long
Zeile = ActiveCell.Row - tbl.HeaderRowRange.Row
With WbTrocknung
.Columns("H").ClearContents
.Columns("L").ClearContents
.Columns("P").ClearContents
.Columns("S").ClearContents
.Columns("U").ClearContents
.Columns("W").ClearContents
.Range("H12").Value = tbl.DataBodyRange(Zeile, 52).Value
.Range("H14").Value = tbl.DataBodyRange(Zeile, 6).Value
.Range("H16").Value = tbl.DataBodyRange(Zeile, 43).Value
.Range("H18").Value = tbl.DataBodyRange(Zeile, 54).Value
.Range("H20").Value = tbl.DataBodyRange(Zeile, 5).Value
.Range("H22").Value = tbl.DataBodyRange(Zeile, 8).Value
.Range("H24").Value = tbl.DataBodyRange(Zeile, 10).Value
.Range("H26").Value = tbl.DataBodyRange(Zeile, 11).Value
.Range("H28").Value = tbl.DataBodyRange(Zeile, 14).Value
.Range("L12").Value = tbl.DataBodyRange(Zeile, 16).Value
.Range("L14").Value = tbl.DataBodyRange(Zeile, 21).Value
.Range("L16").Value = tbl.DataBodyRange(Zeile, 9).Value
.Range("L18").Value = tbl.DataBodyRange(Zeile, 27).Value
.Range("L20").Value = tbl.DataBodyRange(Zeile, 25).Value
.Range("L22").Value = tbl.DataBodyRange(Zeile, 16).Value
.Range("L24").Value = tbl.DataBodyRange(Zeile, 78).Value
.Range("L26").Value = tbl.DataBodyRange(Zeile, 22).Value
.Range("L28").Value = tbl.DataBodyRange(Zeile, 23).Value
.Range("P12").Value = tbl.DataBodyRange(Zeile, 25).Value
.Range("P14").Value = tbl.DataBodyRange(Zeile, 26).Value
.Range("P16").Value = tbl.DataBodyRange(Zeile, 27).Value
.Range("P18").Value = tbl.DataBodyRange(Zeile, 30).Value
.Range("P20").Value = tbl.DataBodyRange(Zeile, 40).Value
.Range("P22").Value = tbl.DataBodyRange(Zeile, 47).Value
.Range("S12").Value = tbl.DataBodyRange(Zeile, 56).Value
.Range("S14").Value = tbl.DataBodyRange(Zeile, 57).Value
.Range("S16").Value = tbl.DataBodyRange(Zeile, 60).Value
.Range("S18").Value = tbl.DataBodyRange(Zeile, 63).Value
.Range("S20").Value = tbl.DataBodyRange(Zeile, 64).Value
.Range("S22").Value = tbl.DataBodyRange(Zeile, 67).Value
.Range("S24").Value = tbl.DataBodyRange(Zeile, 70).Value
.Range("S26").Value = tbl.DataBodyRange(Zeile, 71).Value
.Range("S28").Value = tbl.DataBodyRange(Zeile, 74).Value
.Range("S30").Value = tbl.DataBodyRange(Zeile, 97).Value
.Range("U14").Value = tbl.DataBodyRange(Zeile, 58).Value
.Range("U16").Value = tbl.DataBodyRange(Zeile, 61).Value
.Range("U20").Value = tbl.DataBodyRange(Zeile, 65).Value
.Range("U22").Value = tbl.DataBodyRange(Zeile, 68).Value
.Range("U26").Value = tbl.DataBodyRange(Zeile, 72).Value
.Range("U28").Value = tbl.DataBodyRange(Zeile, 75).Value
.Range("U30").Value = tbl.DataBodyRange(Zeile, 98).Value
.Range("W14").Value = tbl.DataBodyRange(Zeile, 59).Value
.Range("W16").Value = tbl.DataBodyRange(Zeile, 62).Value
.Range("W20").Value = tbl.DataBodyRange(Zeile, 66).Value
.Range("W22").Value = tbl.DataBodyRange(Zeile, 69).Value
.Range("W26").Value = tbl.DataBodyRange(Zeile, 73).Value
.Range("W28").Value = tbl.DataBodyRange(Zeile, 75).Value
.Range("W30").Value = tbl.DataBodyRange(Zeile, 99).Value
.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = False
.Shapes.Range(Array("txt_Bearbeiten", "img_Bearbeiten")).Visible = True
.Select
.Range("I12").Select
End With
Call ws_Protect(ws_DB, ws_Eingabe)
End Sub
Sub TrocknungAnlegen_DBEingabe()
Call ws_Unprotect(ws_DB, ws_Eingabe)
Dim tbl As ListObject
Set tbl = WbDB.ListObjects(1)
With WbTrocknung
.Columns("H").ClearContents
.Columns("L").ClearContents
.Columns("P").ClearContents
.Range("I12").Value = tbl.DataBodyRange(tbl.DataBodyRange.Rows.Count, 1).Value + 1
.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True
.Shapes.Range(Array("txt_Bearbeiten", "img_Bearbeiten")).Visible = False
.Select
.Range("H18").Select
End With
Call ws_Protect(ws_DB, ws_Eingabe)
End Sub
Sub TrocknungAnlegen_EingabeDB()
Call ws_Unprotect(ws_Eingabe, ws_DB)
Dim tbl As ListObject
Set tbl = WbDB.ListObjects(1)
Dim Zeile As Long
If WbTrocknung.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True Then
tbl.ListRows.Add
Zeile = tbl.DataBodyRange.Rows.Count
Else
Zeile = Range("Datenbank[lfd Nr]").Find(What:=WbTrocknung.Range("H18").Value _
, LookIn:=xlValues, LookAt:=xlWhole).Row - tbl.HeaderRowRange.Row
End If
With WbTrocknung
tbl.DataBodyRange(Zeile, 1).Value = .Range("H12").Value
tbl.DataBodyRange(Zeile, 6).Value = .Range("H14").Value
tbl.DataBodyRange(Zeile, 43).Value = .Range("H16").Value
tbl.DataBodyRange(Zeile, 6).Value = .Range("H18").Value
tbl.DataBodyRange(Zeile, 5).Value = .Range("H20").Value
tbl.DataBodyRange(Zeile, 8).Value = .Range("H22").Value
tbl.DataBodyRange(Zeile, 10).Value = .Range("H24").Value
tbl.DataBodyRange(Zeile, 11).Value = .Range("H26").Value
tbl.DataBodyRange(Zeile, 14).Value = .Range("H28").Value
tbl.DataBodyRange(Zeile, 16).Value = .Range("L12").Value
tbl.DataBodyRange(Zeile, 21).Value = .Range("L14").Value
tbl.DataBodyRange(Zeile, 9).Value = .Range("L16").Value
tbl.DataBodyRange(Zeile, 27).Value = .Range("L18").Value
tbl.DataBodyRange(Zeile, 25).Value = .Range("L20").Value
tbl.DataBodyRange(Zeile, 16).Value = .Range("L22").Value
tbl.DataBodyRange(Zeile, 78).Value = .Range("L24").Value
tbl.DataBodyRange(Zeile, 22).Value = .Range("L26").Value
tbl.DataBodyRange(Zeile, 23).Value = .Range("L28").Value
tbl.DataBodyRange(Zeile, 25).Value = .Range("P12").Value
tbl.DataBodyRange(Zeile, 26).Value = .Range("P14").Value
tbl.DataBodyRange(Zeile, 27).Value = .Range("P16").Value
tbl.DataBodyRange(Zeile, 30).Value = .Range("P18").Value
tbl.DataBodyRange(Zeile, 40).Value = .Range("P20").Value
tbl.DataBodyRange(Zeile, 47).Value = .Range("P22").Value
End With
Call Nav_DB
tbl.DataBodyRange(Zeile, 1).Select
Call ws_Protect(ws_Eingabe, ws_DB)
End Sub