AW: Text in nFormeln ersetzen und zählen
27.02.2018 20:25:02
Michael
Hallo Rainer,
vielen Dank für deine Antwort, habe sie leider erst jetzt gelesen, war selber beschäftigt den Code zu basteln. Deinen Code habe ich jetzt nicht mehr getestet, da meiner super funktioniert.
Für alle die es interessiert, dieser Beispielcode überprüft in Formeln die Bezüge zu anderen Dateien und ersetzt sie mit dem Ersatzbezug. Jede Ersetzung wird dabei gezählt.
Sub Bezüge_ersetzen()
Dim Suchbezug As String 'der jeweilige Bezug in einer Formel
Dim Ersatzbezug As String 'Ersatzbezug
Dim Text As String
Dim alt As String, alt1 As String, alt2 As String, alt3 As String
Dim Bereich As Range, rng As Range
Dim i As Integer 'Position in Text um nach dem nächsten Bezug zu suchen
Dim t As Long 'Anzahl der Bezüge die ersetzt wurden
'Ersatzbezug festlegen
Ersatzbezug = "'C:\Eigene Dateien\[Test.xlsm]Tabelle1'!$A$1"
'zu suchenden Bereich festlegen
Set Bereich = Sheets("Tabelle1").Range("A1:B20")
'Zähler auf Null setzen
t = 0
'Bezüge ersetzen und Ersetzungen zählen
For Each rng In Bereich
i = 1
Do
Text = rng.Formula 'Formel aus der jeweiligen Zelle als Referenzbezug alt
alt1 = InStr(i, Text, "]") 'Position des Bezugende festlegen
alt2 = Left(Text, alt1) 'linken Abschnitt der Formel bis zur Klammer
alt3 = InStr(i, alt2, "'") 'Position des ' in dem Formelabschnitt festlegen
If alt1 = 0 Then Exit Do
If alt1 0 Then Suchbezug = Mid(alt2, alt3) 'Suchbezug aus der Formel
i = InStr(i, Text, "'!", vbTextCompare) + 2
If Suchbezug Ersatzbezug Then
If InStr(1, Text, Suchbezug, vbTextCompare) > 0 Then
t = t + 1
rng.Value = Replace(Text, Suchbezug, Ersatzbezug, 1, 1, vbTextCompare)
End If
End If
Loop Until (InStr(1, Text, Suchbezug, vbTextCompare) = 0)
Next
MsgBox t
End Sub
Grüße
Micha