Daten von DB in "Formular überführen"

[Seeqi]

Moin zusammen,

ich arbeite aktuell an einer Auftragsliste die durch VBA verhindern soll, dass div... idioten von meiner Arbeit die Tabellen dauerhaft zerschießen....

Anbei findet ihr meine Datei.

Bis jetzt läuft auch alles gut Aufträge werden vom Formular in die Tabelle eingefügt, die Tabelle wird erweitert usw...
Was aber nicht wirklich klappen will ist, dass er die Daten aus der Übersicht in das Formular lädt, falls ich einen Auftrag bearbeiten will...

Er findet die Werte von der aktiven Zeile aber fügt sie komplett falsch ein...

Evtl. kann mir ja jemand helfen :)

P.s der Aufbau dieser Datei basiert auf den Videos von:
https://www.youtube.com/c/KaiWeissmann

Falls jemand mal in VBA reinschnuppern will wie ich finde ein sehr guter Kanal :)

[Klaus-Dieter]

Hallo,

ist ist ja immer schön zu sehen, wie viel Aufwand und Arbeit in das Design einer Exceldatei gesteckt wird. Über Vor- und Nachteile eines Formulars auf einem Tabellenblatt kann man sich auch vortrefflich diskutieren, ist für dich aber sicher nicht zielführend. 
Was du brauchst, wäre eine, wie auch immer gestaltete Suchfunktion, mit deren Hilfe du die gewünschten Daten in dein Formular bekommst. Da ich persönlich lieber mit UserForms arbeite, habe ich dazu nichts in meinem Archiv. Insofern werde ich in diesem Jahr, keinen Lösungsvorschlag erstellen. Wünsche aber dir, und allen anderen hier im Forum, schon mal einen guten Rutsch ins Jahr 2022.

[ralf_b]

na dann will ich mal  

du hast direkt die Databodyrange des Listobjects benutzt. tbl.databodyrange  Da hängt aber noch die Überschrift mit drin.
wenn du gleich die Listrows anfasst ,dann hast du einen ganzen Datensatz in der Hand.
deine find Schleife war mir unklar. Habe sie deshalb rausgeworfen.

PHP-Code:

Option Explicit
Const ws_DB As String = "Austragsübersicht"
Const Ws_Eingabe As String = "Auftrag anlegen"

Sub Auftragbearbeiten_Übersicht()

'Tabelle einlesen
Dim tbl As ListObject
Dim olstRow As ListRow

 Set tbl = Worksheets(ws_DB).ListObjects(1)
 
 If ActiveCell.ListObject Is Nothing Then Exit Sub
   
   For Each olstRow In tbl.ListRows
      If ActiveCell.Row = olstRow.Range.Row Then Exit For
   Next
    
    'Werte eintragen
    
    With Worksheets(Ws_Eingabe)
        'Spalte L leeren
        .Columns("L").ClearContents
    
       .Cells(12, "L").Value = olstRow.Range.Cells(1)
       .Cells(15, "L").Value = olstRow.Range.Cells(2)
       .Cells(17, "L").Value = olstRow.Range.Cells(3)
       .Cells(19, "L").Value = olstRow.Range.Cells(4)
       .Cells(21, "L").Value = olstRow.Range.Cells(5)
       .Cells(24, "L").Value = olstRow.Range.Cells(6)
       .Cells(27, "L").Value = olstRow.Range.Cells(7)
      ' olstRow.Range.Cells(8)
    
    
     'Tabellenblatt navigieren
     Worksheets("Auftrag anlegen").Activate
    
    'Zelle auswählen
      .Range("L15").Select
    End With

End Sub


Sub Auftraganlegen_Übersicht()

'Tabelle einlesen
Dim tbl As ListObject
Set tbl = Worksheets(ws_DB).ListObjects(1)

With Worksheets(Ws_Eingabe)
    'Spalte L leeren
    .Columns("L").ClearContents
    
    'Nummer eintragen
    .Range("L12").Value = tbl.ListRows(tbl.ListRows.Count).Range.Cells(1).Value + 1
    
    'Tabellenblatt navigieren
     Worksheets(Ws_Eingabe).Activate
    
    'Zelle auswählen
    .Range("L15").Select
    
End With
 

End Sub


Sub Auftraganlegen()

Dim tbl As ListObject
Dim olstRow As ListRow

With Worksheets(ws_DB)
    'Tabelle einlesen
    Set tbl = .ListObjects(1)
    
    'zeile hinzufügen
    Set olstRow = tbl.ListRows.Add
    
    'zeilenhöhe anpasse
    olstRow.RowHeight = tbl.ListRows(1).RowHeight
    
End With

With Worksheets(Ws_Eingabe)
        
       olstRow.Range.Cells(1) = .Cells(12, "L").Value
       olstRow.Range.Cells(2) = .Cells(15, "L").Value
       olstRow.Range.Cells(3) = .Cells(17, "L").Value
       olstRow.Range.Cells(4) = .Cells(19, "L").Value
       olstRow.Range.Cells(5) = .Cells(21, "L").Value
       olstRow.Range.Cells(6) = .Cells(24, "L").Value
       olstRow.Range.Cells(7) = .Cells(27, "L").Value
       olstRow.Range.Cells(8) = 0
       
    'zu Aktion Springen
    Worksheets("Austragsübersicht").Activate
    Application.Goto olstRow.Range.Cells(1), True
    
End With
End Sub 


[Seeqi]

Erstmal allen eine Frohe neues Jahr :)


Vielen Dank Ralf für diesen Supercode...den muss ich mir irgendwann mal zu gemüte führen um zu verstehen was du dort gemacht hast :D

Das einzige Problem was ich jetzt habe ist, dass er mir einen Fehler beim speichern eines Auftrage auswirft :(

[Seeqi]

Danke Ralf,

da ich noch ein frischling im VBA Bereich bin kenne ich mich leider noch nicht so aus :)
Userformen wären denke ich wirklich eine wesentlich attraktivere Lösung :D

Wenn du lust und zeit hast kannst du mich gerne zu dem Thema erleuchten :)

[RPP63]

Userformen wären denke ich wirklich eine wesentlich attraktivere Lösung :D

Moin!
Da bin ich gänzlich anderer Meinung!
Userforms enthalten in der Regel Text oder boolsche Werte.
Fast alles, was Zellen "build in" beherrschen, musst Du einem Userform erst mühsam beibringen!

Ein simples Beispiel:
Du willst nur ein gültiges Datum dieses Jahrzehnts zulassen.

Zelle: Datengültigkeit, zulassen Datum von bis

Textfeld:
zunächst per IsDate() prüfen ob es sich überhaupt um ein Datum handeln könnte
falls ja, Prüfung, ob im Zeitrahmen
falls ja, den Text per CDate() in ein "echtes" Datum umwandeln

Aber ich gebe Dir dahingehend Recht, dass gerade für einen Anfänger ein Userform "cool" aussieht und Kompetenz vortäuscht.
Ich habe dies auch hinter mir. 
Mein letztes ernsthafte Projekt mit UserForms liegt aber mehr als 10 Jahre zurück.
Es enthält 1.500 Zeilen Code.
Alleine das Debugging hat mehr als die Hälfte der benötigten Zeit beansprucht …

Gruß Ralf

[Klaus-Dieter]

Hallo Ralf,

Über Vor- und Nachteile eines Formulars auf einem Tabellenblatt kann man sich auch vortrefflich diskutieren, ist für dich aber sicher nicht zielführend. 

in diesem Sinne, ein frohes neues Jahr.

[ralf_b]

update,

den Fehler habe ich gefunden. Es lag an der Rowheight  Zuweisung. 
die folgende Sub könnte der Nachfolger der fehlerhaften Sub sein. Jetzt kann man geladene Aufträge  auch gleich geändert oder neu speichern.  
Zum Auffinden ob es den Auftrag gibt dient die Nr.
Wenn gefunden, Werte werden überschrieben.
Alternativ eine neue Zeile eingefügt. Nur der Auftragsstatus ist hier noch ungeklärt. 
  
Immer wieder gern verteilt
https://www.thespreadsheetguru.com/blog/...cel-tables

Code:

Sub Auftragspeichern_aendern()

Dim tbl As ListObject
Dim olstRow As ListRow
Dim bgefunden As Boolean

With Worksheets(ws_DB)
    'Tabelle einlesen
    Set tbl = .ListObjects(1)
     
    If tbl.ListRows.Count > 0 Then
      For Each olstRow In tbl.ListRows
         If Worksheets(Ws_Eingabe).Cells(12, "L").Value = olstRow.Range.Cells(1) Then
            bgefunden = True
            Exit For
         End If
      Next
    Else
        bgefunden = False
    End If
   
    'zeile hinzufügen
    If Not bgefunden Then
        Set olstRow = tbl.ListRows.Add
        'zeilenhöhe anpasse
        olstRow.Range.RowHeight = tbl.ListRows(1).Range.RowHeight
    End If
   
End With

With Worksheets(Ws_Eingabe)
       
       olstRow.Range.Cells(1) = .Cells(12, "L").Value
       olstRow.Range.Cells(2) = .Cells(15, "L").Value
       olstRow.Range.Cells(3) = .Cells(17, "L").Value
       olstRow.Range.Cells(4) = .Cells(19, "L").Value
       olstRow.Range.Cells(5) = .Cells(21, "L").Value
       olstRow.Range.Cells(6) = .Cells(24, "L").Value
       olstRow.Range.Cells(7) = .Cells(27, "L").Value
       
       'Was bei ändern?
       olstRow.Range.Cells(8) = 0
       
    'zu Aktion Springen
    Worksheets("Austragsübersicht").Activate
   
    Application.Goto Range("A" & olstRow.Range.Row)
   
End With
End Sub

[Seeqi]

Hallo Ralf,

hab vielen Dank :)
Nun ist von meiner "Codierung" zwar nicht mehr viel vorhanden aber die Datei Funktioniert genau so wie sie es soll 

Muss mir nur noch deinen Code zu gemüte führen, das ich hier auch durchblicke falls es mal nicht mehr funktioniert :)