hier eine VBA Variante
07.10.2011 16:44:41
Tino
Hallo,
kannst mal diesen Code testen.
Der Aufruf erfolgt über Makro1, diese kannst Du einem Button zuweisen.
Das Makro Bearbeite_Verknuepfung wird mit folgenden Parametern aus dieser Sub aufgerufen.
1. Parameter wo das neue Jahr steht.
2. Parameter in welchen Bereich gesucht werden soll.
Die Tabelle bei With Sheets("Tabelle1"), müsstest Du natürlich auch anpassen.
kommt als Code in Modul
Option Explicit
Sub Makro1()
'Tabelle anpassen
With Sheets("Tabelle1")
'1. Parameter Zelle Jahr
'2. Parameter Bereich der durchsucht und ersetzt werden soll
Bearbeite_Verknuepfung .Range("A1"), .Range("A2:A500")
End With
End Sub
Sub Bearbeite_Verknuepfung(rngValue As Range, rngBereich As Range)
Dim ArrayData, n&, nn&, nCount&
Dim strJahr$
strJahr = rngValue.Value
'Eingabe überprüfen
If Not strJahr Like "[2][0][0-5][0-9]" Then
MsgBox "Geben Sie in " & rngValue.Address(0, 0) & " eine Jahreszahl von 2000 bis 2059 an", vbQuestion
Exit Sub
End If
'Bereich der durchsucht werden soll,
With rngBereich
ArrayData = .FormulaR1C1
strJahr = "\" & strJahr & "\"
If Not IsArray(ArrayData) Then
ArrayData = .Resize(, 2).FormulaR1C1
Redim Preserve ArrayData(1 To 1, 1 To 1)
End If
With CreateObject("Vbscript.Regexp")
.MultiLine = True
.Pattern = "\\\d{4,4}\\"
.Global = True
For n = 1 To Ubound(ArrayData)
For nn = 1 To Ubound(ArrayData, 2)
If .test(ArrayData(n, nn)) Then
If .Execute(ArrayData(n, nn))(0) <> strJahr Then
ArrayData(n, nn) = .Replace(ArrayData(n, nn), strJahr)
nCount = nCount + 1
End If
End If
Next nn
Next n
End With
If nCount > 0 Then
Application.EnableEvents = False
Application.DisplayAlerts = False
.FormulaR1C1 = ArrayData
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Es wurde(n) " & nCount & " Formel(n) geändert!", vbInformation
Else
MsgBox "Es wurden keine Formeln geändert!", vbExclamation
End If
End With
End Sub
Man könnte dies auch gleich direkt über Private Sub Worksheet_Change in der Tabelle machen
Dann kommt in die entsprechende Tabelle dieser Code anstatt Makro1.
Private Sub Worksheet_Change(ByVal Target As Range)
'Code abbrechen sollte eingabe nicht in A1 erfolgen
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
With ActiveSheet
'1. Parameter Zelle Jahr
'2. Parameter Bereich der durchsucht und ersetzt werden soll
Bearbeite_Verknuepfung .Range("A1"), .Range("A2:A500")
End With
End Sub
Gruß Tino