AW: Update: Dynamische Listen & auto. Anpassung
22.01.2014 15:14:44
fcs
Hallo Patrick,
ich hab das Worksheet_Change-Ereignismakro jetzt etwas allgemeiner gefasst.
Wichtig ist, dass die Spaltentitel in den Blättern und der Name der Bereich jeweils identisch sind, damit der Abgleich zwischen Legende und Analyseblatt funktioniert. Wenn die Bereichsnamen abweichen, dann ist eine Übersetzungsliste erforderlich, die dann im Makro abgearbeitet werden muss.
Im Legendenblatt solltest du zwischen den Tabellen jeweils eine Spalte leer lassen, die Tabellen sind dann einfacher zu verwalten.
Wenn du eine neue Legende einfügen willst, dann wie folgt vorgehen:
1. ab Zeile 2 zwei gültige Werte eintragen.
2. für die 2 Zellen den Bereichsnamen festlegen.
3. den Spaltentitel eintragen
4. die 3 Zellen markieren und die Tabelle einfügen.
Bei einer anderen Reihenfolge werden eine oder mehrere Fehlermeldungen angezeigt.
Gruß
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varWertNeu, strBereich As String, strMsg As String
Dim ZeileL As Long, Spalte As Long
Dim intFehler As Integer
On Error GoTo Fehler
If Target.Cells.Count = 1 Then
intFehler = 1
strBereich = Cells(1, Target.Column)
If strBereich = "" Then Exit Sub
If Not Intersect(Target, Me.Range(strBereich)) Is Nothing Then
'in Blatt "Analyse" alten durch neuen Wert ersetzen, wenn in Zelle _
im Bereich geändert wurde
varWertNeu = Target.Value
With Worksheets("Analyse")
intFehler = 2
Spalte = .Rows(1).Find(what:=strBereich, LookIn:=xlValues, _
lookat:=xlWhole).Column
ZeileL = .Cells(.Rows.Count, Spalte).End(xlUp).Row
If ZeileL >= 2 Then
intFehler = 3
.Range(.Cells(2, Spalte), .Cells(ZeileL, Spalte)).Replace _
what:=varWertOld, replacement:=varWertNeu, lookat:=xlWhole, _
MatchCase:=True
End If
End With
End If
End If
Fehler:
With Err
strMsg = "Fehler-Nr.: " & .Number & vbLf & .Description
Select Case .Number
Case 0 'alles OK
Case 1004
strMsg = strMsg & vbLf & vbLf
Select Case intFehler
Case 1
strMsg = strMsg & "Bereich mit Name """ & strBereich _
& """ ist noch nicht definiert!"
Case 2
Case 3
End Select
MsgBox strMsg, vbInformation + vbOKOnly, "Makro: Worksheet_Change"
Case 91 '
'do nothing - Spalten-Titel aus Legende wurde in Analyse nicht gefunden
Case Else
MsgBox strMsg, vbInformation + vbOKOnly, "Makro: Worksheet_Change"
End Select
End With
End Sub