Gültigkeitsprüfung

Forumthread: Gültigkeitsprüfung

Gültigkeitsprüfung

21.12.2012 12:09:44

Markus

Hallo zusammen,
ich möchte mehrere Blätter von der Gültigkeitsprüfung ausschließen,
wie müßte das aussehen?
Auszuschließende Sheets: Vorgaben, Zusammenfassung und Änderungen
Vielen Dank im Voraus
Markus

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngZelle As Range, rngBereich As Range, bolFehler As Boolean
If UCase(Sh.Name)  "Vorgaben" Then
Set rngBereich = Intersect(Sh.Range("A1:B20,A23:B42"), Target)
If Not rngBereich Is Nothing Then
For Each rngZelle In rngBereich
If IsNumeric(rngZelle) Then
If rngZelle  1 Then bolFehler = True
ElseIf Application.CountIf(Sheets("Vorgaben").Range("A1:B10"),rngZelle) = 0 _
Then
bolFehler = True
End If
If bolFehler Then
MsgBox "Achtung Fehler!"
Application.Undo
Exit Sub
End If
Next
End If
End If
End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Gültigkeitsprüfung

21.12.2012 12:16:53

Rudi
Ausnahmen in ARRAY speichern

21.12.2012 12:20:07

NoNet

AW: Gültigkeitsprüfung

21.12.2012 12:16:53

Rudi

Hallo,
eine Möglichkeit:

'....
Dim arrSh
arrSh = Array("Vorgaben", "Zusammenfassung", "Änderungen")
If IsError(Application.Match(Sh.Name, arrSh, 0)) Then
'....

Gruß
Rudi

Ausnahmen in ARRAY speichern

21.12.2012 12:20:07

NoNet

Hallo MArkus,
ein Hinweis vorweg : Dein Code kann SO wohl kaum funktionieren, denn UCase(Sh.Name) "Vorgaben" ist immer WAHR, da UCASE("Vorgaben") den Namen KOMPLETT in Grossbuchstaben vergleicht : "VORGABEN" "Vorgaben" !
Zu Deinem Vorhaben : Speichere die Namen der Ausnahmenblätter in einer ARRAY-Variablen und vergleiche den aktuellen Blattnamen mit diesem ARRAY. Hier der passende Code :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngZelle As Range, rngBereich As Range, bolFehler As Boolean
Dim strAusnahmen
strAusnahmen = Array("Vorgaben", "Zusammenfassung", "Änderungen")
If Not IsNumeric(Application.Match(Sh.Name, strAusnahmen)) Then
Set rngBereich = Intersect(Sh.Range("A1:B20,A23:B42"), Target)
If Not rngBereich Is Nothing Then
For Each rngZelle In rngBereich
If IsNumeric(rngZelle) Then
If rngZelle  1 Then bolFehler = True
ElseIf Application.CountIf(Sheets("Vorgaben").Range("A1:B10"), rngZelle) = 0 _
Then
bolFehler = True
End If
If bolFehler Then
MsgBox "Achtung Fehler!"
Application.Undo
Exit Sub
End If
Next
End If
End If
End Sub

Salut, NoNet

Beliebteste Forumthreads (12 Monate)

Forumthread: Gültigkeitsprüfung

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread