Ergebnisse in Text umwandeln
#1
Hallo an alle,

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.

Vielen herzlichen Dank
ippomu


Angehängte Dateien
.xlsm   forum - ergebnisse in text umwandeln.xlsm (Größe: 30,64 KB / Downloads: 6)
Antworten Top
#2
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
 
  'Set rng = Intersect(rCol, rCol.Rows("6:54"))  => Entfällt
  Set rng = rCol
 
  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


LG
Norbert
Antworten Top
#3
Hallo Norbert,

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.

Vielen herzlichen Dank
ippomu
Antworten Top
#4
Hallo, 

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

LG
Norbert
Antworten Top
#5
Hallo Norbert,

ich habe nun den Code eingebaut. Es waren dabei nur die Zellen mit den "x" als Koordinaten anzupassen.

Der Code funktioniert einwandfrei, bis auf folgendes:

Im Bereich H96:H144 ist in den Zellen diese Formel eingebaut

=WENNFEHLER(WENN($AI$5="x";VERKETTEN($D150;" ";
INDEX(db_bew!$B$222:$B$234;VERGLEICH(VRUNDEN(MITTELWERTWENN(beo_2_sem!$AT14:$AX14;"<>0");0,5);db_bew!$A$222:$A$234;0));
INDEX(db_bew!$J$222:$J$234;VERGLEICH(VRUNDEN(MITTELWERTWENN(beo_2_sem!$AH14:$AL14;"<>0");0,5);db_bew!$A$222:$A$234;0));
INDEX(db_bew!$N$222:$N$234;VERGLEICH(VRUNDEN(MITTELWERTWENN(beo_2_sem!$AN14:$AR14;"<>0");0,5);db_bew!$A$222:$A$234;0)));"");"")

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?

Vielen Dank
ippomu
Antworten Top
#6
Hallo,

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.

LG
Norbert
Antworten Top
#7
Hallo Norbert,

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.

Herzlichen Dank für deine wertvolle Hilfe.

Ippomu
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste