Hilfe bei Datenüberprüfung!

[cysu11]

Hallo Uwe,


vielen Dank für den Code, den ich gleich getestet habe! Dieser funktioniert SUPER, allerdings bei mir nur wenn ich in A2 etwas eintrage, das liegt wahrscheinlich daran, dass die Textlänge für die Spalte A nur in AC2 zu finden ist!
Der Einfachheit Halber und weil ich von einer Lösung ohne VBA ausgegangen bin, habe ich nur für Spalte A angefragt! SORRY!

Folgendes möchte ich noch ergänzen:

1. Für die Spalte A aber erst ab A3 soll die Datenprüfung stattfinden aufgrund der Textlänge die in AC2(Steht immer fest hier für Spalte A) steht.
2. Für die Spalte B aber erst ab B3 soll die Datenprüfung stattfinden aufgrund der Textlänge die in AD2(Steht immer fest hier für Spalte B) steht usw.
3. Das ganze entsprechend weiterführen für alle weiteren Spalten bis
    Für die Spalte N aber erst ab N3 soll die Datenprüfung stattfinden aufgrund der Textlänge die in AP2(Steht immer fest hier für Spalte N) steht


Vielen Dank im Voraus
LG
Alexandra

[Kuwer]

Hallo Alexandra,

teste mal damit:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dim rngL As Range

 On Error Resume Next

 Application.EnableEvents = False

 If Not Application.Intersect(Target, Range("A3:N" & Rows.Count), ActiveSheet.UsedRange) Is Nothing Then

   Set rngL = Cells(2, Target.Column + 28)

   With Target.Validation

     .Delete

     .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _

           Operator:=xlLessEqual, Formula1:=CStr(rngL.Value)

     .IgnoreBlank = True

     .InCellDropdown = True

     .InputTitle = ""

     .ErrorTitle = ""

     .InputMessage = ""

     .ErrorMessage = "ACHTUNG, maximale Textlänge von " & rngL.Value & " überschritten!"

     .ShowInput = True

     .ShowError = True

   End With

 End If

 Application.EnableEvents = True

End Sub

Gruß Uwe

[Käpt'n Blaubär]

Hallo Alexandra,

sorry, ich hatte einen Arzttermin und bin gerade erst wieder zur Haustüre rein.
Aber Du bist ja in allerbesten Händen gelandet.

[cysu11]

Hallo Uwe,


das funktioniert super!!! :) Eine Frage noch, die Spalten M bis AP sind in der Datei ausgeblendet, dann funktioniert dein Code nicht, nur wenn die Spalten M bis AP eingeblendet sind.
Gibt es eine Möglichkeit dass es auch bei ausgeblendeten Spalten M bis AP funktioniert?


Vielen lieben Dank
LG
Alexandra

[cysu11]

Hallo Uwe,


ich habe den/mein Fehler gefunden! Es waren nicht die Ausgeblendeten Spalten sondern der Schreibschutz! :20:


Nun funktioniert es perfekt!! :)


Vielen lieben Dank nochmals
LG
Alexandra

[cysu11]

Hallo Alexandra,

teste mal damit:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dim rngL As Range

 On Error Resume Next

 Application.EnableEvents = False

 If Not Application.Intersect(Target, Range("A3:N" & Rows.Count), ActiveSheet.UsedRange) Is Nothing Then

   Set rngL = Cells(2, Target.Column + 28)

   With Target.Validation

     .Delete

     .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _

           Operator:=xlLessEqual, Formula1:=CStr(rngL.Value)

     .IgnoreBlank = True

     .InCellDropdown = True

     .InputTitle = ""

     .ErrorTitle = ""

     .InputMessage = ""

     .ErrorMessage = "ACHTUNG, maximale Textlänge von " & rngL.Value & " überschritten!"

     .ShowInput = True

     .ShowError = True

   End With

 End If

 Application.EnableEvents = True

End Sub

Gruß Uwe

Hallo Uwe,


der Code funktioniert prima, es ist jetzt nur
ein Problem aufgetreten und zwar kann ich keine Werte mehr mit STRG+C und STRG+V kopieren und einfügen!? Es ist nur in dieser Datei in den anderen Dateien geht es!
Hast du eine Idee woran das liegt?

Vielen Dank im Voraus
LG Alexandra

[cysu11]

Hallo Alexandra,

teste mal damit:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dim rngL As Range

 On Error Resume Next

 Application.EnableEvents = False

 If Not Application.Intersect(Target, Range("A3:N" & Rows.Count), ActiveSheet.UsedRange) Is Nothing Then

   Set rngL = Cells(2, Target.Column + 28)

ActiveSheet.Unprotect Password:="999"

   With Target.Validation

     .Delete

     .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _

           Operator:=xlLessEqual, Formula1:=CStr(rngL.Value)

     .IgnoreBlank = True

     .InCellDropdown = True

     .InputTitle = ""

     .ErrorTitle = ""

     .InputMessage = ""

     .ErrorMessage = "ACHTUNG, maximale Textlänge von " & rngL.Value & " überschritten!"

     .ShowInput = True

     .ShowError = True

   End With

 End If

 Application.EnableEvents = True

ActiveSheet.Protect Password:="999"

End Sub

Gruß Uwe

Hallo Uwe,


ich habe das Problem gefunden, es ist wieder der Schreibschutz! :) Habe ich oben rot markiert!
Wenn ich STRG-C drücke dann blinkt/kreist der Zellenrand, aber sobald ich die Zelle verlasse dann hört das blinken/kreisen auf! Wenn ich die zwei Zeilen auskommentiere im Code dann geht es, aber ich brauche diesen Schreibschutz! Was kann ich da machen?


Vielen Dank
VG
Alexandra

[Kuwer]

Hallo Alexandra,

wie Du selbst festgestellt hast, widersprechen sich Deine Anforderungen.
Unabhängig davon kann man durch Copy/Paste die Längenbegrenzung austricksen. Wozu soll das also gut sein?

Gruß Uwe