Text in Formeln ersetzen

Gepostet am: Jan 21, 2011 10:57:33 PM

Formeln_aendern()

Public Sub Formeln_aendern()Dim myRange As Range Set myRange = Application.InputBox("Wählen Sie den Bereich aus, in dem Sie die Formeln ändern möchten:", "Bereich auswählen:", , , , , , 8)Dim myNames As StringDim RI As IntegerDim CI As Integer  strReplace1 = InputBox("Geben Sie den Text ein, der ersetzt werden soll:", "zu ersetzen:") strReplace2 = InputBox("Geben Sie den Text ein, der stattdessen eingesetzt werden soll:", "ersetzen durch:")For CI = 1 To myRange.Columns.Count     For RI = 1 To myRange.Rows.Count         myRange.Cells(RI, CI).Select         ActiveCell.Formula = Replace(ActiveCell.Formula, strReplace1, strReplace2)     NextNextEnd Sub

Soweit die rudimentäre Funktion. In folgender verbesserter Version, werden folgende Dinge berücksichtigt:

• • Änderungsprotokoll als TMP-Datei

  • da mir die Schriftformatierungen durch obrigen Code teilweise geändert wurden, wurde dies behoben

Formeln_aendern()

Public Sub Formeln_aendern()Dim myRange As Range Dim objFSO As ObjectDim wshShell As ObjectDim strTempDir As StringDim strTempFile As StringSet objFSO = CreateObject("Scripting.FileSystemObject")Set wshShell = CreateObject("Wscript.Shell")  strTempDir = wshShell.ExpandEnvironmentStrings("%TEMP%") strTempFile = objFSO.BuildPath(strTempDir, objFSO.GetTempName & ".txt")Open strTempFile For Append As #1Print #1, "Name des Tabellenblattes:" & ActiveSheet.Name & vbCr  Set myRange = Application.InputBox("Wählen Sie den Bereich aus, in dem Sie die Formeln ändern möchten:", "Bereich auswählen:", , , , , , 8)Dim myNames As StringDim RI As IntegerDim CI As IntegerDim i As IntegerDim oldFormula As String i = 0  strReplace1 = InputBox("Geben Sie den Text ein, der ersetzt werden soll:", "zu ersetzen:") strReplace2 = InputBox("Geben Sie den Text ein, der stattdessen eingesetzt werden soll:", "ersetzen durch:")For CI = 1 To myRange.Columns.Count     For RI = 1 To myRange.Rows.Count         myRange.Cells(RI, CI).Select         If InStr(ActiveCell.Formula, strReplace1) <> 0 Then             oldFormula = ActiveCell.Formula             ActiveCell.Formula = Replace(ActiveCell.Formula, strReplace1, strReplace2)             i = i + 1             Print #1, ActiveCell.Address & "|=|" & oldFormula & "|geändert in=|" & ActiveCell.Formula & vbCr         End If     NextNextClose #1If MsgBox("Es wurden " & i & " Änderungen vorgenommen." & vbCr & "Wollen Sie die Änderungen ansehen", vbInformation + vbYesNo, "Ergebnis") = vbYes Then     wshShell.Run (strTempFile)End IfSet objFSO = NothingSet objFile = NothingEnd Sub

Verbesserungsvorschläge und Wünsche werden gerne entgegengenommen.