ich bin neu im Forum und hoffe Hilfe zu bekommen, um folgendes Problem zu lösen: Der VBA-Code in der Datei ermöglicht es, dass unter der Bedingung ein "x" steht in Zelle AG4, die in den darunter liegenden Zellen (in Zeilen 6:54) durch Formeln entstandenen Ergebnisse in Text umgewandelt werden und in dem Moment wo das "x" gelöscht wird, wieder die Formeln zurückkehren. Dasselbe passiert in Spalte AI und AK und alles funktioniert bestens.
Es besteht aber die Notwendigkeit die Funktion zu erweitern und dabei benötige ich bitte eure Hilfe.
Das Ziel der Erweiterung ist, dass wenn in AG4 das "x" steht weiterhin die Ergebnisse der darunter liegenden Zellen (in Zeilen 6:54) in Text umgewandelt werden, aber wenn auch ein "x" in O93 steht, dieselbe Umwandlung auch für die Ergebnisse in H96:H144 erfolgt. Ebenso sollte dies für AI4 und bei "x" auch in O147 für den Bereich H150:H198 erfolgen.
Ich habe versucht mit zusätzlichen "If Not Intersect" zu einer möglichen Lösung zu gelangen, aber vergebens.
Ich hoffe jemand hat Zeit und Lust mir weiterzuhelfen bzw. die Erweiterung zu lösen.
07.03.2023, 10:57 (Dieser Beitrag wurde zuletzt bearbeitet: 07.03.2023, 10:58 von daNorbert.)
Hallo,
ich weiß jetzt nicht was genau Du schon versucht hast, aber trotzdem ein versuch Dich zu unterstützen:
Bei Deinen bestehenden Funktionen wendest Du die Funktion direkt auf die Spalte an, in der das X steht. Sprich AG kannst Du so einfach mit erweitern. Bei den anderen ist das jetzt anders, deshalb misst Du das für die etwas anders aufbauen.
In Deiner Formel zum schreiben und wiederherstellen der Formel werden die Zeilen 6-54 betrachtet. Da Du nun auch andere Zeilen hast musst Du das direkt beim Aufruf mitgeben und Deine 2 Funktionen entsprechend leicht anpassen.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("AG4,AI4,AK4")) Is Nothing Then 'Für AG4, AI4 und AK4 jeweils die aktuelle Spalte Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Target.EntireColumn.Rows("6:54") 'Hier schon die Zeilen anpassen Else RestoreFormula Target.EntireColumn.Rows("6:54") 'Hier schon die Zeilen anpassen End If Application.EnableEvents = True End If
If Not Intersect(Target, Range("O93")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("H96:H144") Else RestoreFormula Range("H96:H144") End If Application.EnableEvents = True End If
If Not Intersect(Target, Range("O147")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("H150:H198") Else RestoreFormula Range("H150:H198") End If Application.EnableEvents = True End If
End Sub
Code:
Option Explicit
Sub SaveFormula(ByVal rCol As Range) Dim rng As Range, aRng As Variant
aRng = rng.Formula ThisWorkbook.Names.Add rCol.Cells(4, 1).Address(0, 0) & "rngFormula", aRng rng.Copy rng.PasteSpecial xlPasteValues Application.CutCopyMode = False rCol.Cells(4, 1).Select Set rng = Nothing End Sub
Sub RestoreFormula(ByVal rCol As Range) Dim sName As String, aRng As Variant sName = rCol.Cells(4, 1).Address(0, 0) aRng = Evaluate(sName & "rngFormula") 'If VarType(aRng) = 8204 Then Intersect(rCol, rCol.Rows("6:54")).Formula = aRng If VarType(aRng) = 8204 Then rCol.Formula = aRng End Sub
zu Beginn schon ein großes Dankeschön, dass du Dir die Zeit genommen hast mein Post zu lesen und bereit warst mir zu helfen.
Ich wusste mir nicht zu helfen, wie ich im Code die Zeilen der Spalten AG, AK, AI mit den Bereichen H96:H144 usw. vereinbaren konnte. Ich hatte versucht den Range von AG4 auf O93 zu erweitern und dadurch den zweiten Bereich zu blockieren, aber vergebens. Wenn ich es richtig verstanden habe, könnte man auch den ersten Bereich des Codes so aufbauen, dass die drei Spalten AG, Ak, AI unabhängig, nicht als Spalte und davon die Zeilen, sondern wie in deiner Erweiterung, als definierter Bereich behandelt werden:
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("AG4")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("AG6:AG54") Else RestoreFormula Range("AG6:AG54") End If Application.EnableEvents = True End If
If Not Intersect(Target, Range("AI4")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("AI6:AI54") Else RestoreFormula Range("AI6:AI54") End If Application.EnableEvents = True End If
If Not Intersect(Target, Range("AK4")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("AK6:AK54") Else RestoreFormula Range("AK6:AK54") End If Application.EnableEvents = True End If
If Not Intersect(Target, Range("O93")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("H96:H144") Else RestoreFormula Range("H96:H144") End If Application.EnableEvents = True End If
If Not Intersect(Target, Range("O147")) Is Nothing Then Application.EnableEvents = False If UCase(Target.Value) = "X" Then SaveFormula Range("H150:H198") Else RestoreFormula Range("H150:H198") End If Application.EnableEvents = True End If
End Sub
Der Code wird dabei länger, aber jede Option von der anderen unabhängig. z.B. könnte ich die Funktion durch AK4 unabhängig von AG und AI nur den Zeilen 4:16 zuweisen oder evtl. auch Zellen in einer anderen Spalte zuweisen, oder durch AG4 automatisch (ohne O93) sowohl den Bereich AG6:AG54 als auch den Bereich H96:H144 zuweisen!?
Den Bereich des Codes den ich nicht verstehe ist
Code:
If VarType(aRng) = 8204 Then rCol.Formula = aRng
Verbleibe auf deine Rückmeldung und baue inzwischen deine wertvolle Hilfe in mein Arbeitsblatt ein und überprüfe, dass auch dort alles funktioniert.
Für die erste Frage - Ja, das sollte so funktionieren.
Zur 2. Frage:
Der Part ist 1:1 von Deinem ursprünglichen Code übernommen lediglich Der Bereich Intersect(rCol, rCol.Rows("6:54")) (Hier war fix die Zeilenanzahl hinterlegt) habe ich direkt in den Bereich geändert (rCol)
Aber prinzipiell wird hier die Formel reingeschrieben mit einer kleinen Prüfung, ob der Wert ein Array ist.
Code:
'If VarType(aRng) = 8204 Then Intersect(rCol, rCol.Rows("6:54")).Formula = aRng If VarType(aRng) = 8204 Then rCol.Formula = aRng
Wenn ich das "x" in H94 (neue richtige Koordinate) eingebe wird der Inhalt, also das Ergebnis der Formeln, problemlos in Text umgewandelt, aber wenn ich das "x" entferne kommt in allen Zellen der Fehler #WERT und nicht mehr das Ergebnis durch die Formel vor. Wenn ich aber diese Formeln in ein Stützbereich, also auf andere Zellen, verlege und im Bereich H96:H144 nur den Verweis z.B. =Y96 eingebe, in dem Moment wo ich das "x" entferne ist wieder das Ergebnis durch die Formel zu sehen (und keine Fehlermeldung). Hast du eine Idee warum das passiert?
Noch eine kleine Frage: Warum nachdem ich das "x" und Enter eigegeben habe versetzt sich der Marker der ausgewählten Zelle immer 5 Zellen darunter und nicht wie normal 1 Zelle darunter?
das mit den 5 Zeilen darunter stammt auch noch aus Deinem ursprünglichen Code. Habe da nichts verändert, weil ich mir dachte - das wird schon so gewollt sein..
Im Code unten siehst Du die Zeile, die dafür verantwortlich ist. Die einfach entfernen oder den 4er durch einen 1er ersetzen. Code:
Code:
Option Explicit
Sub SaveFormula(ByVal rCol As Range) ... rCol.Cells(4, 1).Select ... End Sub
Deine Formel in H96:H144 ist eine Index Formel, das geht dann nicht auf diesem Weg.
alles klar, danke. Also nicht alle Formeln sind mit dem Code kompatible. Ich ging davon aus, dass der Code den Text (also die Funktionen) der Formeln zwischenlagert und dann wieder einsetzt. Habe aber ja das Problem mit Stützzellen und auf diese den Verweis gelöst.
Nun habe ich auch das mit den 5 Zeilen darunter verstanden.
Ergebnisse in Text umwandeln
