Inhalt einer Zelle mit Formel

Moin Leute,
ich habe eine Tabelle die normalerweise eine Spalte in eine andere Tabelle als Zeile umschreibt und Änderungen ständig überwacht. (diese benötige ich später für Serienbriefe und als Übersichtsliste)
Nun wollte ich der ganzen Sache etwas mehr Flexibilität verleihen. Der Plan war diese Spalte in die Spalte Z zu verschieben und mit Formeln zu befüllen. Diese verweisen auf einen anderen Ort in demselben Tabellenblatt.
Das würde mich befähigen unterschiedliche Formulare zu erstellen ohne das die Funktion an sich gestört wird.
DAS PROBLEM:
VBA nimmt die Werte die als Ergebnis einer Formel stehen nicht an. Würde ich die Werte per Hand in der Spalte Z notieren würde das ganze funktionieren.
Ich denke ich brauche sowas wie "WERT einfügen" für target.value. Ich habe schon gegoogelt aber ich finde nichts dergleichen.
Ich habe mal eine Tabelle vorbereitet. Die grünen Felder sind die Felder in die die Daten notiert werden sollen. Deren Position und Verteilung kann sich immer wieder ändern. Diese sollen dann in die blauen Felder übernommen und von dort in das Sheet "LISTE" übertragen werden.
Kann mir da Bitte jemand helfen?
Hier die Datei:
https://www.herber.de/bbs/user/133422.xlsm
Und hier der Code aus "Diese Arbeitsmappe":
Option Explicit

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range)
Dim blattno, bereich
Dim quellbereich, zelle
'die blätter bei denen nix passierne soll
blattno = Array("Daten", "Startseite", "Liste", "Master")
quellbereich = Array("Z5:Z24")
If InStr(1, "@" & Join(blattno, "@") & "@", "@" & sh.Name & "@", vbTextCompare) > 0 Then Exit _
Sub
If target.Count = 1 Then
'nur ein Eintrag erfolgte
If Not Intersect(target, sh.Range(quellbereich(0))) Is Nothing Then
aktualisieren sh, target
End If
Else
'mehrere Einträge erfolgen
For Each zelle In target
If Not Intersect(zelle, sh.Range(quellbereich(0))) Is Nothing Then
aktualisieren sh, zelle
End If
Next
End If
End Sub

Sub aktualisieren(sh As Object, ByVal target As Range)
Dim ziel
Dim spalte
Set ziel = Worksheets("LISTE").Columns(1).Find(sh.Name, LookIn:=xlValues, lookat:=xlWhole)
If ziel Is Nothing Then Exit Sub
spalte = target.Row - 1
Worksheets("LISTE").Cells(ziel.Row, spalte) = target.Value
End Sub
Liebe Grüße
Steve

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range) Dim arrBezug As Variant, strBezug As String Dim rngZelle As Range, rngZiel As Range If Not IsNumeric(Sh.Name) Then Exit Sub strBezug = "B5,B6,B13,B14,J20,J21,J22,B25,B26,B27,D9,D10,D26,D27,H10,H11,H12,M24,M25,M26" If Intersect(target, Sh.Range(strBezug)) Is Nothing Then Exit Sub arrBezug = Array(Split(strBezug, ",")) For Each rngZelle In target If Not Intersect(rngZelle, Sh.Range(strBezug)) Is Nothing Then Set rngZiel = Worksheets("LISTE").Columns(1).Find(Sh.Name, LookIn:=xlValues, lookat:=xlWhole) If rngZiel Is Nothing Then Exit Sub Else Worksheets("LISTE").Cells(rngZiel.Row, _ Application.Match(rngZelle.Address(0, 0), arrBezug, 0) + 3) = rngZelle End If End If Next rngZelle End Sub

Die Hilfsspalte Z brauchst du mit meinem Vorschlag nicht mehr.
Der String:

strBezug = "B5,B6,B13,B14,J20,J21,J22,B25,B26,B27,D9,D10,D26,D27,H10,H11,H12,M24,M25,M26"

wird in ein Array/Datenfeld (quasi eine virtuelle Tabelle) umgewandelt:

arrBezug = Array(Split(strBezug, ","))

was dann mit der Formel VERGLEICH (Match) abgeglichen wird:

Application.Match(rngZelle.Address(0, 0), arrBezug, 0) + 3

womit sich automatisch der Spaltenindex (der wievielte Eintrag im Datenfeld) ergibt.
Ein Datenfeld speichert also mehrere Werte in einer einzigen Variable ab.
In deinem ursprünglichen Code hast du den Text-String "Z5:Z24" in einem Array gespeichert, was zwar auch funktioniert, jedoch nicht im Sinne des Erfinders ist.

Dim quellbereich As Variant
quellbereich = Array("Z5:Z24")
If Not Intersect(target, sh.Range(quellbereich(0))) Is Nothing Then

Dein Code entspricht:

Dim strQuellbereich As String
strQuellbereich = "Z5:Z24"
If Not Intersect(target, sh.Range(strQuellbereich)) Is Nothing Then

Im vorliegenden Fall kann man aber auch gleich eine Range definieren:


Dim rngQuellbereich As Range
rngQuellbereich = sh.Range("Z5:Z24")
If Not Intersect(target, rngQuellbereich) Is Nothing Then

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range) Dim rngZiel As Range If Not IsNumeric(Sh.Name) Then Exit Sub Set rngZiel = Worksheets("LISTE").Columns(1).Find(Sh.Name, LookIn:=xlValues, lookat:=xlWhole) If rngZiel Is Nothing Then Exit Sub Else Sh.Range("Z5:Z24").Copy Worksheets("LISTE").Range("D" & rngZiel.Row).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True End If Application.CutCopyMode = False End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim rngZiel As Range If Not IsNumeric(Sh.Name) Then Exit Sub Application.ScreenUpdating = False Set rngZiel = Worksheets("LISTE").Columns(1).Find(Sh.Name, LookIn:=xlValues, lookat:=xlWhole) If Not rngZiel Is Nothing Then Sh.Range("Z5:Z24").Copy Worksheets("LISTE").Range("D" & rngZiel.Row).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True Application.CutCopyMode = False End If End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Inhalt einer Zelle mit Formel

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread