Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1428to1432
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Formeln durch Werte ersetzen und speichern unter

Formeln durch Werte ersetzen und speichern unter
11.06.2015 09:48:44
Sarah
Hallo zusammen,
ich habe ein Makro, das in den Tabellenblättern die Formeln durch Werte ersetzen soll und dann die Datei durch speichern unter als neue Version abspeichern soll. Das heißt ich hätte gerne danach zwei Dateien. Eine mit Formeln und eine nur mit den Werten und jeweils unterschiedlichen Namen.
Hier der Code den ich bisher habe, aber das Ergebnis davon ist, dass es am Ende zwei Dateien gibt, die nur Werte enthalten. Außerdem ist nach wie vor die Datei geöffnet in dem das Ganze gestartet wurde und ich hätte gerne die Datei geöffnet, die durch speichern unter erstellt wird.
Wäre super, wenn ihr mir helfen könnt!
Viele Grüße
Sarah
Sub g_Create_Report()
'Definition der Variablen
Dim sPfad As String
Dim sMonat As String
Dim sJahr As String
Dim sTG As String
Dim sProzess As String
Dim sBlatt As Object
Application.Calculate
'Jahr festlegen
sJahr = Worksheets("ini").Range("Jahr")
'Quellpfad festlegen
sPfad = Worksheets("ini").Range("Pfad_Report")
'TG festlegen
sTG = Worksheets("ini").Range("TG")
'Prozess festlegen
sProzess = Worksheets("ini").Range("B5")
'Einmal durchrechnen das Ganze
Worksheets("Agenda").Activate
Application.Calculate
'alle Mappen einblenden
For Each sBlatt In Worksheets
sBlatt.Visible = True
Next sBlatt
'Formeln durch Werte ersetzen
Sheets(Array("ini", "Cover", "Agenda", "Mgmt_Summary", "KF_PTG", "KF_VTG", "Customer_Count", "  _
_
Retention Rate_v", "GAP", "Ranking", "synthPF", _
"clock", "Data_WF_CS", "Data_WF_P&L", "WF", "Additional", "Personnel", "P&L", "OE_NS_roll", " _
CSC_SI", _
"Business Model")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
'Blätter ausblenden
Sheets("ini").Visible = xlHidden
Sheets("Cover").Visible = xlHidden
Sheets("Customer_Count").Visible = xlHidden
Sheets("Retention Rate_v").Visible = xlHidden
Sheets("GAP").Visible = xlHidden
Sheets("Ranking").Visible = xlHidden
Sheets("synthPF").Visible = xlHidden
Sheets("Clock").Visible = xlHidden
Sheets("Data_WF_CS").Visible = xlHidden
Sheets("Data_WF_P&L").Visible = xlHidden
Sheets("3YP_Qual").Visible = xlHidden
Sheets("3YP_Quant").Visible = xlHidden
Sheets("Agenda").Activate
Range("A1").Select
'Arbeitsmappe unter neuem Namen speichern
ActiveWorkbook.SaveAs Filename:="" & sPfad, FileFormat:=52
MsgBox (sTG & "_BoardPackage_" & sProzess & "_" & sJahr & "_v.xlsm in Verzeichnis " & sPfad & "  _
_
gespeichert!")
End Sub

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formeln durch Werte ersetzen und speichern unter
11.06.2015 10:08:14
Klexy
Vor
'Formeln durch Werte ersetzen
Diese Zeile einfügen:
ActiveWorkbook.Save

AW: Formeln durch Werte ersetzen und speichern unter
11.06.2015 10:22:32
Sarah
Hallo Klexy,
das Problem besteht immernoch. Die Ergänzung ergab keine Veränderung im Ergebnis.

AW: Formeln durch Werte ersetzen und speichern unter
11.06.2015 10:39:26
Klexy
Wenn du die Original-Datei erst speicherst, dann die Formeln killst und dann wieder unter neuem Namen speicherst, hast du 2 Dateien. Eine mit Formeln und eine ohne. Die ohne ist am Ende noch offen.

AW: Formeln durch Werte ersetzen und speichern unter
11.06.2015 10:41:51
Sarah
Genau das wollte ich ja machen, siehe Code unten.
Aber es funktioniert nicht.
Wo ist der Fehler im Code?

Anzeige
lad doch mal die Musterdatei hoch
11.06.2015 11:02:05
UweD

AW: lad doch mal die Musterdatei hoch
11.06.2015 11:05:56
Sarah
Hallo Uwe,
das geht leider nicht, da interne Daten enthalten sind.
Der Code steht unten. Es handelt sich um eine Datei mit mehreren Arbeitsblättern und Formeln und diese sollen durch Werte ersetzt werden. Nichts kompliziertes.
Nur der Code macht nicht das was er soll.

AW: lad doch mal die Musterdatei hoch
11.06.2015 11:25:43
Klexy
Interne Daten können anonymisiert werden. Aber ich befürchte, dass die Datei mit so vielen Blättern einfach zu groß sein würde. Herber akzeptiert nur bis 300 kB
Sub Klexys_Musterdatei_Anonymisator()
' zu anonymisierende Zellen markieren und Makro laufen lassen
' !!! Zellen mit Formeln dürfen NICHT anonymisiert werden !!!
' !!! Zellen mit eindeutigen Schlüsselwerten (Matchcode) dürfen NICHT anonymisiert werden
'     weil sie sonst alle gleich lauten und ihre Funktionalität einbüßen
' !!! Spaltenköpfe sollten im Sinne der Verständlichkeit NICHT anonymisiert werden
' die Zeichen werden durch andere Zeichen mit annähernd gleicher Breite (in Arial) ersetzt
'     damit die Befüllung der Zellen möglichst identisch bleibt
' die Buchstaben L,J,I werden vorläufig nicht ersetzt, weil sie nicht durch genau gleich
'     breite Buchstaben ersetzt werden können (kann unten aber aktiviert werden).
' die Ziffer 1 bleibt, weil sie oft eine besondere Bedeutung hat und
'     auch nicht durch eine gleich breite Ziffer ersetzt werden kann
' die Ziffer 0 bleibt, weil sie oft eine besondere Bedeutung hat
' Ziffern
Selection.Replace What:="4", Replacement:="2", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="5", Replacement:="3", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="6", Replacement:="2", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="7", Replacement:="3", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="8", Replacement:="2", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="9", Replacement:="3", LookAt:=xlPart, MatchCase:=True
' Kleinbuchstaben
Selection.Replace What:="ä", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="d", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="e", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="f", Replacement:="t", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="g", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="h", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="j", Replacement:="i", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="k", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="l", Replacement:="i", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="n", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="o", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="ö", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="p", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="q", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="r", Replacement:="t", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="s", Replacement:="c", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="u", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="ü", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="v", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="w", Replacement:="m", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="x", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="y", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="z", Replacement:="c", LookAt:=xlPart, MatchCase:=True
' Großbuchstaben
Selection.Replace What:="A", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Ä", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="C", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="F", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="G", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="H", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="K", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="O", Replacement:="N", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Ö", Replacement:="N", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="P", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Q", Replacement:="N", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="R", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="S", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="T", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="U", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Ü", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="V", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="W", Replacement:="M", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="X", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Y", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Z", Replacement:="E", LookAt:=xlPart, MatchCase:=True
'Selection.Replace What:="I", Replacement:="J", LookAt:=xlPart, MatchCase:=True
'Selection.Replace What:="L", Replacement:="J", LookAt:=xlPart, MatchCase:=True
End Sub

Anzeige
AW: lad doch mal die Musterdatei hoch
11.06.2015 11:37:36
UweD
Hallo nochmal
Die Datei muss natürlich VOR dem "PasteSpecial" selbst mit 'save' gespeichert werden.
Ganz unten dann mit 'SaveAs'.
Da hast du aber KEINEN Dateinamen drin..
und auch gehört der Pfad davor.
Ich hab es mal so abgeändert.
Sub g_Create_Report()
'Definition der Variablen
Dim sPfad As String
Dim sMonat As String
Dim sJahr As String
Dim sTG As String
Dim sProzess As String
Dim sBlatt As Object
Dim sFName As String
Application.Calculate
'Jahr festlegen
sJahr = Worksheets("ini").Range("Jahr")
'Quellpfad festlegen
sPfad = Worksheets("ini").Range("Pfad_Report")
'TG festlegen
sTG = Worksheets("ini").Range("TG")
'Prozess festlegen
sProzess = Worksheets("ini").Range("B5")
'Einmal durchrechnen das Ganze
Worksheets("Agenda").Activate
Application.Calculate
'alle Mappen einblenden
For Each sBlatt In Worksheets
sBlatt.Visible = True
Next sBlatt
'Formeln durch Werte ersetzen
Sheets(Array("ini", "Agenda")).Select
Sheets(Array("ini", "Cover", "Agenda", "Mgmt_Summary", "KF_PTG", "KF_VTG", " _
Customer_Count", _
"Retention Rate_v", "GAP", "Ranking", "synthPF", _
"clock", "Data_WF_CS", "Data_WF_P&L", "WF", "Additional", "Personnel", "P&L", " _
OE_NS_roll", _
"CSC_SI", "Business Model")).Select
ActiveWorkbook.Save
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
'Blätter ausblenden
Sheets("ini").Visible = xlHidden
Sheets("Cover").Visible = xlHidden
Sheets("Customer_Count").Visible = xlHidden
Sheets("Retention Rate_v").Visible = xlHidden
Sheets("GAP").Visible = xlHidden
Sheets("Ranking").Visible = xlHidden
Sheets("synthPF").Visible = xlHidden
Sheets("Clock").Visible = xlHidden
Sheets("Data_WF_CS").Visible = xlHidden
Sheets("Data_WF_P&L").Visible = xlHidden
Sheets("3YP_Qual").Visible = xlHidden
Sheets("3YP_Quant").Visible = xlHidden
Sheets("Agenda").Activate
Range("A1").Select
'Arbeitsmappe unter neuem Namen speichern
sFName = sTG & "_BoardPackage_" & sProzess & "_" & sJahr & "_v"
ActiveWorkbook.SaveAs Filename:=sPfad & sFName, FileFormat:=52
MsgBox (sFName & ".xlsm in Verzeichnis " & sPfad & " gespeichert! ")
End Sub
Gruß UweD

Anzeige
AW: Formeln durch Werte ersetzen und speichern unter
11.06.2015 11:21:53
Klexy
Kann nicht sein. Wenn du die Datei nach dem Paste Values unter einem neuen Namen abspeicherst, hast du eine zweite Datei ohne Formeln.
Geh den Code mal mit F8 Zeile für Zeile durch und beobachte, was geschieht.
Vielleicht enthält dein Sheet-Array nicht alle Blätter und du schaust just in das rein, das du beim Paste Values nicht mitgenommen hast?

AW: Formeln durch Werte ersetzen und speichern unter
11.06.2015 13:04:52
Sarah
Vielen Dank euch beiden!
Das Problem hat sich erledigt. Liegt nicht am Code, sondern an der Datenbank, auf der die Datei aufbaut.

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige