AW: BEREICH.VERSCHIEBEN per VBA ändern
18.03.2014 12:38:48
fcs
Hallo Ulrike,
das kann jetzt richtig kompliziert werden.
Nachfolgend mal ein Code Beispiel.
Wichtig:
jedes Blatt muss aktiviert werden.
Es muss die 1. Zelle des Bereiches des Datengültigkeit angepasst werden soll aktiviert werden.
Die Datengültigkeitsprüfung/-Formel muss passend für diese 1. Zelle eingegeben werden.
In der vom Makrorekorder aufgezeichneten deutschen Formel
- müssen die englischen Funktionen verwendet werden
- müssen ggf. Dezimal-Komma durch Dezimal-Punkte ersetzt werden
- müssen die Semikolons durch Kommas ersetzt werden.
Am besten zeichnest du mit dem Makrorekorder die zu ändernden Datengültigkeitsprüfungen eines Tabellenblattes in einem Makro auf. Das Makro dabei in deiner pesönlichen Makroarbeitsmappe speichern.
Danach kannst du dann mein Beispiel als Basis verwenden und für jeden Zellbereich bzw. Zelle einen entsprechenden Code Block zu erstellen.
Gruß
Franz
Sub BedingteFormatierung()
' Bedingte Formatierung in Zellbereichen anpassen
Dim wkb As Workbook, wks As Worksheet, rngCheck As Range, Zeile As Long
Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets
With wks
.Activate
'1. Zellbereich
Zeile = .UsedRange.Row + .UsedRange.Rows.Count - 1 'ggf. anpassen
'Datengültig für Bereich D2 bis Dxxx anpassen
'Bereich, dessen Datengültigkeitsprüfung gesetzt werden soll
Set rngCheck = .Range(.Cells(2, 4), .Cells(Zeile, 4)) 'anpassen !!!
With rngCheck
'1. Zelle des Bereiches aktivieren
.Range("A1").Activate
With .Validation
.Delete 'vorhandene Prüfung ggf. löschen
'für Formula1 muss die Deutsche Funktion in die Englische umgesetzt werden _
das Semikolon in der Formeln muss durch Komma ersetzt werden und _
das Dezimalkomma ggf. durch einen Dezimalpunkt
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, _
Formula1:="=OFFSET(D$1,ROW(D2)-1,-COLUMN(D$1)+1)=D2" 'Formel anpassen!!!
'deutsche Formel: =BEREICH.VERSCHIEBEN(D$1;ZEILE(D2)-1;-SPALTE(D$1)+1)=D2
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Irgendein Titel" 'ggf. anpassen
.InputMessage = ""
.ErrorMessage = "Zulässig ist Wert in Spalte A" 'ggf. anpassen
.ShowInput = True
.ShowError = True
End With
End With
'2. ZOellbereich
'Datengültig für Bereich E2 anpassen
'Bereich, dessen Datengültigkeitsprüfung gesetzt werden soll
Set rngCheck = .Range("E2") 'anpassen !!!
With rngCheck
'1. Zelle des Bereiches aktivieren
.Range("A1").Activate
With .Validation
.Delete 'vorhandene Prüfung ggf. löschen
'für Formula1 muss die Deutsche Funktion in die Englische umgesetzt werden _
das Semikolon in der Formeln muss durch Komma ersetzt werden und _
das Dezimalkomma ggf. durch einen Dezimalpunkt
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, _
Formula1:="=OFFSET(E$1,ROW(E2)-1,-COLUMN(E$1)+1)=E2" 'Formel anpassen!!!
'deutsche Formel: =BEREICH.VERSCHIEBEN(E$1;ZEILE(E2)-1;-SPALTE(E$1)+1)=E2
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Irgendein Titel" 'ggf. anpassen
.InputMessage = ""
.ErrorMessage = "Zulässig ist Wert in Spalte A" 'ggf. anpassen
.ShowInput = True
.ShowError = True
End With
End With
End With
Next wks
End Sub