ich bin jetzt kein Profi in VBA, aber ich habe ein Problem. Sicherlich gibt es einen Trick, wie man meinen VB Code verkleinern kann, damit es mit dem Kompilieren wieder klappt. Ich habe schon gegoogelt, aber ich werde nicht fündig weil ich nicht weiß wonach ich schauen muss.
Ich habe für die Spalte F und G und den jeweiligen Zeilen jeweils ein VB Code, jetzt müsste ich das noch für die Spalten J, K, N, O, R, S, V und W machen. Aber bereits beim J und K erweitern stoße ich an die Grenze.
Das VB macht, wenn z.B. in der F3 etwas eingetragen wird - nichts. Wird der Inhalt der F3 wieder gelöscht, wird eine vordefinierte Formel in die Zelle geschrieben. Das ganze soll je einzelner Zelle funktionieren, was es mit meiner Programmierung macht.
Es soll nicht, wenn ich in F3 etwas lösche eine Zelle F6 oder G8 oder so mit der Formel befüllen.
Hier mein Code-Snippet:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' Ereignisse vorübergehend deaktivieren
' Spalte F
If Not Intersect(Target, Me.Range("F3")) Is Nothing And Me.Range("F3").Value = "" Then
Me.Range("F3").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If
If Not Intersect(Target, Me.Range("F6")) Is Nothing And Me.Range("F6").Value = "" Then
Me.Range("F6").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If
' ... das geht jetzt so im 3-er Schritt weiter bis zur Zeile 240
If Not Intersect(Target, Me.Range("F237")) Is Nothing And Me.Range("F237").Value = "" Then
Me.Range("F237").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If
If Not Intersect(Target, Me.Range("F240")) Is Nothing And Me.Range("F240").Value = "" Then
Me.Range("F240").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Kalkulation(intern)'!$I$3:$I$68,""Fehlt"")"
End If
' Spalte G
If Not Intersect(Target, Me.Range("G4")) Is Nothing And Me.Range("G4").Value = "" Then
Me.Range("G4").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If
If Not Intersect(Target, Me.Range("G7")) Is Nothing And Me.Range("G7").Value = "" Then
Me.Range("G7").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If
' ... das geht jetzt so im 3-er Schritt weiter bis zur Zeile 241
If Not Intersect(Target, Me.Range("G238")) Is Nothing And Me.Range("G238").Value = "" Then
Me.Range("G238").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If
If Not Intersect(Target, Me.Range("G241")) Is Nothing And Me.Range("G241").Value = "" Then
Me.Range("G241").Formula = "=XLOOKUP(LOOKUP($A$1,'Kalkulation(intern)'!$A$4:$C$56)-4,'Allgemeine Daten'!$C$3:$C$68,'Allgemeine Daten'!$D$3:$D$68,""Fehlt2"")"
End If
Application.EnableEvents = True ' Ereignisse wieder aktivieren
End Sub
Für die Spalte J und K ist die Formel etwas anders, da ist es dann ein -3 anstelle -4
Für die Spalte N und O ist die Formel dann -2
Für die Spalte R und S ist die Formel dann -1
Für die Spalte V und W dann -0 oder bzw. die Rechenoperation wird weg gelassen.
Die Zeilennummern sind immer die gleichen.
Wie kann ich den Code vereinfachen? Ich habe keine Ahnung.
Falls jemand die Excel benötigt, dann bitte eine PN mit E-Mail-Anschrift, dann sende ich diese ausserhalb des Forums zu. Ich möchte aus dieser doch schon sehr gewachsenen Excel keine "Beispieldatei" bauen müssen.
Vielen Dank schon mal.
LG
Clamsy