Excel Makro Script Parameter auf Blatt umbenennen
Erscheinungsbild
Folgendes Script benennt alle Parameter auf einem Blatt um, inkl. der Zellbezüge bzw. Verwendung in Formeln.
- Es werden alle Parameter mit
"_VORLAGE_betrieb"oder"_VORLAGE_setup"im Namen umbenannt - Der neue Name Setzt sich wie folgt zusammen: <blatt><parametername>
Sub Start_ErsetzeVorlageMitBlattname_ohneAt()
Dim ws As Worksheet
Dim rng As Range, c As Range
Dim f As String
Dim Blattname As String
Dim Suchtext_Betrieb As String
Dim Suchtext_Setup As String
Dim countReplaced As Long
' Aktuelles Blatt und Zieltext
Set ws = ActiveSheet
Blattname = Replace(ws.Name, " ", "_")
Suchtext_Betrieb = "_VORLAGE_betrieb"
Suchtext_Setup = "_VORLAGE_setup"
On Error Resume Next
Set rng = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "Keine Formeln im Blatt '" & Blattname & "' gefunden.", vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
countReplaced = 0
For Each c In rng.Cells
'f = CStr(c.FormulaR1C1)
f = CStr(c.Formula2)
If InStr(1, f, Suchtext_Betrieb, vbTextCompare) > 0 Then
'c.FormulaR1C1 = Replace(f, Suchtext_Betrieb, Blattname, 1, -1, vbTextCompare)
c.Formula2 = Replace(f, Suchtext_Betrieb, Blattname, 1, -1, vbTextCompare)
countReplaced = countReplaced + 1
End If
If InStr(1, f, Suchtext_Setup, vbTextCompare) > 0 Then
'c.FormulaR1C1 = Replace(f, Suchtext_Setup, Blattname, 1, -1, vbTextCompare)
c.Formula2 = Replace(f, Suchtext_Setup, Blattname, 1, -1, vbTextCompare)
countReplaced = countReplaced + 1
End If
Next c
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox countReplaced & " Formeln angepasst im Blatt '" & Blattname & "'.", vbInformation
End Sub