Mehrere Werte und Formeln übertragen VBA
06.09.2022 10:56:20
Dennis
Ich versuche unsere Excel Tabelle zu optimieren. (https://www.herber.de/bbs/user/154995.xlsx)
Und zwar tragen wir hier Werte in Tabelle1 ein und anhand dieser Werte berechnen sich einige andere Sachen.
Früher wurde alles per Hand in eine Zeile eingetragen und dann die Formeln runter kopiert, mitlerweile habe ich es hinbekommen eine schöne Userform zu programmieren, die, die erste Zeile findet und die Werte einträgt, sowie auch die Formeln.
Jetzt kam allerdings die Bitte auch eine Masseneingabe einzuführen.
Diese würde so funktionieren, dass Gemarkung, VN-Nummer, Datum1 und Bearbeiter immer gleich bleiben, aber Flurstücke mehrere Werte hat.
Diese Werte bekommen wir auch aus einem anderen Programm in Tabellen Form heraus, deshalb dachte ich mir, ein extra Blatt, in welchem die Werte eingetragen werden, dann in das erste Blatt rüberkopiert werden und anschließend alle Zellen geleert werden, wäre die beste Lösung.
Doch wie setze ich das um?
Mein erster Ansatz sieht wie folgt aus:
Private Sub Masseneingabe_Flurstücke()
Dim Gemarkung As String
Gemarkung = Range("B2").Value
Dim VNNummer As String
VNNummer = Range("B3").Value
Dim Projekt As String
Projekt = Range("B4").Value
Dim Bearbeiter As String
Bearbeiter = Range("B5").Value
Dim Leer As String
Leer = ""
erste_volle_Zeile = Sheets("Tabelle2").Range("A8").End(xlUp)
Dim Flurstueck As String
Do
Flurstueck = Worksheets(2).Range("A8").Cells(erste_volle_Zeile, 1).Value
Range("A8").Cells(erste_volle_Zeile, 1).Value = ""
Tabelle1.Activate
Cells(erste_freie_Zeile, 2).Value = Gemarkung
Cells(erste_freie_Zeile, 5).Value = VNNummer
Cells(erste_freie_Zeile, 3).Value = Flurstueck
Cells(erste_freie_Zeile, 4).Value = Projekt
Cells(erste_freie_Zeile, 10).Value = Bearbeiter
erste_freie_Zeile = Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row
With Cells(erste_freie_Zeile, 11)
.FormulaR1C1 = _
"=IF(RC[-5]="""",IF(RC[-4]="""","""",EDATE(RC[-4],24)),EDATE(RC[-5],3))"
End With
With Cells(erste_freie_Zeile, 1)
.FormulaR1C1 = _
"=IF(RC[1]="""","""",VLOOKUP(RC[1],Tabelle3!R1C1:R3407C2,2,FALSE))"
End With
With Cells(erste_freie_Zeile, 17)
.FormulaR1C1 = _
"=IF(RC[-15]=""Heidelberg"",""Gz"",IF(RC[-15]=""Mannheim"",""Lz"",IF(RC[-15]=""Bruchsal"",""Az"",IF(RC[-15]=""Weinheim"",""Vz"",LEFT(RC[-15],5)))))"
End With
With Cells(erste_freie_Zeile, 24)
.FormulaR1C1 = _
"=IF(RC[-13]TODAY()+7,2,""""))"
End With
Cells(erste_freie_Zeile, 12).Value = Cells(1, 16)
Loop
End Sub
Der Teil mit "Erste_freie_zeile" ist der selbe code wie in meiner Userform und sollte so auch funktionieren, nur müsste im ersten Teil ab Zeile A8 der erste Wert als Flurstücks Value gesetzt, dann geleert und dann den Wert (erste_volle_zeile) auf +1 setzen, damit er eine Zeile weiter geht, bis er eine leere Zelle findet.
Vielen Dank für jede Hilfe