AW: Datenüberprüfung - Liste
09.02.2016 11:24:43
Michael
Hallo Uwe!
das ist ja der Hammer. Genau so sollte es sein. Das funktioniert wunderbar.
Freut mich, Dankeschön!
hoffe aber, ich darf noch eine weitere Frage hierzu stellen.
Für Fragen ist das Forum da! In dem Fall ist es ja eine Folgefrage - gänzlich neue Themen solltest Du aber in einem neuen Faden aufmachen.
Mit Rahmen um M und N - ich hab noch einen Teil auskommentiert, und zwar, dass zunächst im Bereich plus rechter Nebenspalte die Rahmenlinien zunächst rückgesetzt/entfernt werden; wenn Du das auch haben willst, musst Du an entsprechender Stelle das Auskommentieren aufheben.
Sub Liste()
Dim Ws As Worksheet
Dim Bereich As Range
'Auf dem aktiven Tabellenblatt, ggf. ändern
Set Ws = ActiveSheet
With Ws
'Bereich für Datenüberprüfung bestimmen, hier:
'Spalte M von Zeile 2 bis zur letzten gefüllten Zeile in A ,ggf. ändern
Set Bereich = .Range("M2:M" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
'' +++ Optional, wenn gewünscht Auskommentierung aufheben +++
'' Rahmenlinien im oben definierten Bereich + rechter Nebenspalte aufheben
' With Bereich.Resize(Bereich.Rows.Count, 2)
' .Borders(xlDiagonalDown).LineStyle = xlNone
' .Borders(xlDiagonalUp).LineStyle = xlNone
' .Borders(xlEdgeLeft).LineStyle = xlNone
' .Borders(xlEdgeTop).LineStyle = xlNone
' .Borders(xlEdgeBottom).LineStyle = xlNone
' .Borders(xlEdgeRight).LineStyle = xlNone
' .Borders(xlInsideVertical).LineStyle = xlNone
' .Borders(xlInsideHorizontal).LineStyle = xlNone
' End With
'Datenüberprüfung im Bereich setzen, hier:
'Liste mit 5 Pseudo-Werten, entsprechend ändern
With Bereich.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Lorem,Ipsum,Dolor,Sit,Amet"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'Einfache, gesamte Rahmenlinie in Spalte M und N, bezogen auf
'den oben definierten Bereich
Set Bereich = Bereich.Resize(Bereich.Rows.Count, 2)
Bereich.Borders(xlDiagonalDown).LineStyle = xlNone
Bereich.Borders(xlDiagonalUp).LineStyle = xlNone
With Bereich.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Bereich.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Bereich.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Bereich.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Bereich.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Bereich.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Passt?
LG
Michael