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 :)
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.
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
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 :(
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 :)
(01.01.2022, 10:38)Seeqi schrieb: [ -> ]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
Hallo Ralf,
Zitat:Ü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.
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
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 :)