Anzeige
Archiv - Navigation
1232to1236
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Gültigkeitsprüfung per VBA

Gültigkeitsprüfung per VBA
Paulo
Hallo Freunde,
Ich benutze folgenden code um in 2 Spalten die Eingabe auf Ihre Gültigkeit zu prüfen. Hatte vorher die Normale Gültigkeitsprüfung war aber mit dem Scrollen nicht so die Sache. Habe es dann in VBA versucht,
Jetzt ist das Scrollen wunderbar nur bei Eingabe dauert es eine Ewigkeit bis er die Prüfung erledigt.
Kann man den Code nicht etwas beschleunigen oder kürzen ?
Im voraus Danke
Paulo

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngC As Range, Meldung As String, rngM As Range
Dim rngD As Range, Meldung1 As String, rngN As Range
If Not Intersect(Target, Columns(5)) Is Nothing And Target.Row >= 30 Then
For Each rngD In Intersect(Target, Columns(5))
Select Case True
Case rngD Like ""
Case rngD Like Range("AI17").Value
Case rngD Like Range("AJ17").Value
Case rngD Like Range("AK17").Value
Case rngD Like Range("AL17").Value
Case rngD Like Range("AM17").Value
Case rngD Like Range("AN17").Value
Case rngD Like Range("AO17").Value
Case rngD Like Range("AP17").Value
Case rngD Like Range("AQ17").Value
Case rngD Like Range("AR17").Value
Case rngD Like Range("AS17").Value
Case rngD Like Range("AT17").Value
Case rngD Like Range("AU17").Value
Case rngD Like Range("AV17").Value
Case rngD Like Range("AW17").Value
Case rngD Like Range("AX17").Value
Case rngD Like Range("AY17").Value
Case rngD Like Range("AZ17").Value
Case rngD Like Range("BA17").Value
Case rngD Like Range("BB17").Value
Case rngD Like Range("BC17").Value
Case rngD Like Range("BD17").Value
Case rngD Like Range("BE17").Value
Case rngD Like Range("BF17").Value
Case rngD Like Range("BG17").Value
Case rngD Like Range("BH17").Value
Case rngD Like Range("BI17").Value
Case rngD Like Range("BJ17").Value
Case rngD Like Range("BK17").Value
Case rngD Like Range("BL17").Value
Case Else
Meldung1 = Meldung1 & vbLf & rngD.Address
If rngN Is Nothing Then
Set rngN = rngD
Else
Set rngN = Union(rngN, rngD)
End If
End Select
Next
If Meldung1  "" Then
rngN.Select
MsgBox "Wrong Missing Code: " & vbLf & Meldung1
Application.EnableEvents = False
rngN = ""
Application.EnableEvents = True
End If
End If
If Not Intersect(Target, Columns(7)) Is Nothing And Target.Row >= 30 Then
For Each rngC In Intersect(Target, Columns(7))
Select Case True
Case rngC Like ""
Case rngC Like Sheets("DATEN").Range("A252").Value
Case rngC Like Sheets("DATEN").Range("A253").Value
Case rngC Like Sheets("DATEN").Range("A254").Value
Case rngC Like Sheets("DATEN").Range("A255").Value
Case rngC Like Sheets("DATEN").Range("A256").Value
Case rngC Like Sheets("DATEN").Range("A257").Value
Case rngC Like Sheets("DATEN").Range("A258").Value
Case rngC Like Sheets("DATEN").Range("A259").Value
Case rngC Like Sheets("DATEN").Range("A260").Value
Case rngC Like Sheets("DATEN").Range("A261").Value
Case rngC Like Sheets("DATEN").Range("A262").Value
Case rngC Like Sheets("DATEN").Range("A263").Value
Case rngC Like Sheets("DATEN").Range("A264").Value
Case rngC Like Sheets("DATEN").Range("A265").Value
Case rngC Like Sheets("DATEN").Range("A266").Value
Case rngC Like Sheets("DATEN").Range("A267").Value
Case rngC Like Sheets("DATEN").Range("A268").Value
Case rngC Like Sheets("DATEN").Range("A269").Value
Case rngC Like Sheets("DATEN").Range("A270").Value
Case rngC Like Sheets("DATEN").Range("A271").Value
Case rngC Like Sheets("DATEN").Range("A272").Value
Case rngC Like Sheets("DATEN").Range("A272").Value
Case rngC Like Sheets("DATEN").Range("A273").Value
Case rngC Like Sheets("DATEN").Range("A274").Value
Case rngC Like Sheets("DATEN").Range("A275").Value
Case rngC Like Sheets("DATEN").Range("A276").Value
Case rngC Like Sheets("DATEN").Range("A277").Value
Case rngC Like Sheets("DATEN").Range("A278").Value
Case rngC Like Sheets("DATEN").Range("A279").Value
Case rngC Like Sheets("DATEN").Range("A280").Value
Case rngC Like Sheets("DATEN").Range("A281").Value
'Case rngC Like Sheets("DATEN").Range("A282").Value
'Case rngC Like Sheets("DATEN").Range("A283").Value
Case Else
Meldung = Meldung & vbLf & rngC.Address
If rngM Is Nothing Then
Set rngM = rngC
Else
Set rngM = Union(rngM, rngC)
End If
End Select
Next
If Meldung  "" Then
rngM.Select
MsgBox "Wrong Missing Code: " & vbLf & Meldung
Application.EnableEvents = False
rngM = ""
Application.EnableEvents = True
End If
End If
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Gültigkeitsprüfung per VBA
19.10.2011 13:09:24
Rudi
Hallo,
probier das mal:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngC As Range, Meldung As String, rngM As Range
Dim rngD As Range, Meldung1 As String, rngN As Range
If Not Intersect(Target, Columns(5)) Is Nothing And Target.Row >= 30 Then
For Each rngD In Intersect(Target, Columns(5))
If IsError(Application.Match(rngD, Range("AI17:BL17"), 0)) Then
Meldung1 = Meldung1 & vbLf & rngD.Address
If rngN Is Nothing Then
Set rngN = rngD
Else
Set rngN = Union(rngN, rngD)
End If
End If
Next
If Meldung1  "" Then
MsgBox "Wrong Missing Code: " & vbLf & Meldung1
Application.EnableEvents = False
rngN.Select
rngN = ""
Application.EnableEvents = True
End If
End If
If Not Intersect(Target, Columns(7)) Is Nothing And Target.Row >= 30 Then
For Each rngC In Intersect(Target, Columns(7))
If IsError(Application.Match(rngC, Sheets("Daten").Range("A252:A281"), 0)) Then
Meldung = Meldung & vbLf & rngC.Address
If rngM Is Nothing Then
Set rngM = rngC
Else
Set rngM = Union(rngM, rngC)
End If
End If
Next
If Meldung  "" Then
MsgBox "Wrong Missing Code: " & vbLf & Meldung
Application.EnableEvents = False
rngM.Select
rngM = ""
Application.EnableEvents = True
End If
End If
End Sub

Gruß
Rudi
Anzeige
AW: Gültigkeitsprüfung per VBA
19.10.2011 13:44:50
Paulo
Danke Rudi,
Der Code ist schon deutlich kürzer, aber ist noch genau so langsam wie vorher.
Kann man die Prüfung auch nicht etwas beschleunigen, oder gibt es eine andere Möglichkeit diese in VBA zu bewältigen.
Gruß Paulo
AW: Gültigkeitsprüfung per VBA
19.10.2011 13:57:57
Rudi
Hallo,
die Bremse muss woanders sein.
1000 ausgefüllte Zellen bringen bei mir in 0,08 Sek. die Msgbox. Und meine Büchse ist echt lahm.
Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige