für folgendes Problem suche ich nach einer Lösung und komme nicht wirklich weiter mit Excel. Die SuFu hatte ich auch schon genutzt, jedoch nicht wirklich weitergekommen. Daher denke ich, dass da wahrscheinlich Excel mit Verbindung mit VBA her müsste.
Spalte A: 1. Januar bis 31. Dezember - Bezeichnungen für die Tage // also 365 Einträge Spalte B: Formel: 20-C-D-E-F (fortlaufende Variable je Spalte), ebenfalls 365 Einträge // Hier soll eingesehen werden, ob an bestimmten Tagen eine bestimmte Anzahl von Items zur Verfügung hat Spalte C,D,E,F: Standardmäßig auf 0 gesetzt, ebenfalls 365 Einträge pro Spalte// Hier soll der Nutzer an einem bestimmten Tag, die gewünschte Anzahl an Items eintragen können.
Und jetzt mein Problem: nach dem der User zB an einem beliebigen Tag seinen Eintrag in Spalte C,D,E,F durchgeführt hat, sollen alle SECHS darüberliegenden UND darunterliegenden Zellen den eingetragenen Wert übertragen bekommen.
Mit gewöhnlichen Excel-Funktionen scheint dieses Problem nicht so einfach gelöst werden zu können, meiner Einschätzung nach. Dachte zuerst an Wenn-Dann oder Übernehmen-Funktion, aber die sind da zu statisch.
Danke für die Unterstützung schon mal. Meine Datei ist im Anhang
08.04.2025, 11:43 (Dieser Beitrag wurde zuletzt bearbeitet: 08.04.2025, 11:44 von BigJane.)
Hi,
der einfache VBA Code würde so lauten (Change Event im Worksheet, nicht im Modul). Allerdings stelle ich mir noch Fragen - was ist z.B. wenn eine zu überschreibende Zelle schon einen Eintrag enthält, also meintet wegen eine 4 drin steht und ein anderer Eintrag eine 6 erzeugen will? Ich vermute einfach dass in der Anwendung noch weitere Bedingungen dazukommen, z.B. wenn es ums Löschen oder korrigieren geht weil die verfügbare Menge von 20 überschritten wurde oder so. Es wäre also schön gleich alle möglichen Fälle zu formulieren bevor wir hier zig Runden drehen.
Ich war auch überrascht, dass du von 365 Einträgen sprichst und die Zeilen dann doch bei 255 enden weil die Wochenenden nicht enthalten sind.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'abbrechen wenn nicht im Zielbereich oder mehr als eine Zelle If Intersect(Target, Range("C3:F255")) Is Nothing Or Target.Count > 1 Then Exit Sub
'Zeile prüfen Dim i As Integer i = 9 - Target.Row If i < 0 Then i = 0
'ausfüllen Target.Offset(-6 + i, 0).Resize(13 - i, 1).Value = Target.Value
Private Sub Worksheet_Change(ByVal Target As Range) Dim i& Application.EnableEvents = False On Error GoTo Fehler If Not Intersect(Target, Range("C3:F255")) Is Nothing Then For i = -6 To 6 If i <> 0 And Cells(Target.Row + i, 2) = 0 Then MsgBox "Geht nicht, da überlappender Eintrag ensteht": Application.EnableEvents = True: Exit Sub Next i If Target.Row < 9 Then MsgBox "Eintrag nicht möglich, da weniger als 6 freie Einträge davor vorhanden sind": Application.EnableEvents = True: Exit Sub If Cells(Target.Row, 2) = 0 Then Range("C" & Target.Row & ":F" & Target.Row).Copy Range("C" & Target.Row - 6 & ":F" & Target.Row + 6).PasteSpecial Paste:=xlPasteValues End If End If Application.EnableEvents = True Exit Sub Fehler: MsgBox "Eintrag nicht möglich, da weniger als 6 freie Einträge davor vorhanden sind" Application.EnableEvents = True End Sub
08.04.2025, 14:24 (Dieser Beitrag wurde zuletzt bearbeitet: 08.04.2025, 14:26 von snb.)
Reicht schon:
Code:
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C3:F255")) Is Nothing And Target.Count = 1 Then Target.Offset(, -Target.Column + 3).Resize(, 4) = Target End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C3:F255")) Is Nothing And Target.Count = 1 Then Target.Offset(, -Target.Column + 3).Resize(, 4) = Target End Sub
Und: lösche alle verbundene Zellen !!!
Die 4 Zellen der Zeile auszufüllen war aber nicht die Anforderung --> also reicht nicht!
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C3:F255")) Is Nothing And Target.Count = 1 Then Target.Offset(Application.Max(3 - Target.Row, -6)).Resize(7 + Application.Min(Target.Row - 3, 6)) = Target End Sub