Office: (Office 2007) Gewisse Zeichen verhindern ...

User · 18. November 2007

Hallo

Habe das eine kleine Frage ...
Ist es mit Excel 2007 möglich ":" , ";" , "." beim tippen zu verhindern??
Also das es einfach nicht die zeichen annimmt?

Und ist es möglich dann auch darauf aufmerksam zu machen und nicht nur einfach das zeichen zu ignorieren?

MFG
XYZ Unbekannt

:)

jinx · 20. November 2007

Moin, XYZ Unbekannt,

entweder über Daten/Gültigkeit (dann müssen alle Zellen damit ausgestattet werden) oder per VBA - das WorksheetChange-Ereignis z.B.

User · 20. November 2007

Hi Jinx

ähm auf alle Zelle anwenden ist in meinem Fall nicht möglich da ich an anderer Stelle ":" brauche ...

Ähm mit VBA kenn ich mich gar nicht aus
Wäre es möglich wenn du mir das beschreibst?

Und danke für die Schnelle antwort...

MFG
XYZ Unbekannt

jinx · 20. November 2007

Moin, XYZ Unbekannt,

klingt nach Termintool - nur Buchstaben und Ziffern bei Eingabe oder die Verwendung einer UserForm mit einer Textbox und Verwendung von KeyPress, was bei der Eingabe das Zeichen prüft und unzulässge "aussortiert"..

User · 20. November 2007

Hi jinx

Ich hab mir das kopiert was unter dem Link zufinden war, aber das ist ein Fenster in da man was eingeben kann worauf der bei eingabe nicht gültiger zeichen eine Fehlermeldung bringt...

Ich habe mir das ehr so irgendwie vorgestellt das es beim tippen in eine Zelle darauf achtet oder, dass man das makro startet und es werden halt gewisse Zellen überprüft unn verbessert ...

jinx · 20. November 2007

Moin, XYZ Unbekannt,

schn, wenn Du Dir die Lösung vorstellen kannst (und das ist ehrlich gemeint), aber meines Wissens überwacht Excel nicht das Eintippen von Zeichen in ein eZelle, sondern nur, wenn diese Eingabe abgeschlossen ist. Von daher muss zuerst geklärt werden, was denn nun gemacht werden soll.

Nach Eingabe: zuständig dafür ist das Worksheet_Change-Ereignis (hinter die enstprechende Tabelle). Dieser Code schreibt nach Eingabe in der Spalte A jeweils den ersten Buchstaben eines Wortes groß und in Splate C den gesamten Eintrag):

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

With Target
If .Column = 1 Or .Column = 3 Then
Application.EnableEvents = False
If .Column = 1 Then
.Value = Application.Proper(.Value)
Else
.Value = UCase(.Value)
End If
Application.EnableEvents = True
End If
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

User · 21. November 2007

Hi jinx ich muss mich noch bedanken für deine schnellen und gute antworten.

Ich muss noch mal sagen das ich von dem Makros gar keine Ahnung habe!

Also ich habe jetzt aus deinem Code und von dem Link dies zusammen gefriemelt

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

With Target
If .Column = 1 Then
Application.EnableEvents = False
Dim a As String
Dim i As Integer

a = .Value
For i = 1 To Len(a)
If InStr(1, ",1234567890", LCase(Mid(a, i, 1))) = 0 Then
MsgBox "nochmal"
GoTo hierhin
Exit For
End If
Next
hierhin:
Application.EnableEvents = True
End If
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Könntest du mir noch helfen das er ein Punkt gegen ein Komma tausch falls man halt ein Punkt eingetippt hat??

MFG
XYZ Unbekannt

User · 21. November 2007

Achso wäre halt gut wenn er immer ein Komma setzen würde egal was da steht also auch wenn da ein : ist ...

So das nur Zahlen und ein Komma erlaubt sind

jinx · 21. November 2007

Moin, XYZ Unbekannt,

auf den Sprungbefehl kannst Du verzichten:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim strText As String
Dim intPos As Integer

With Target
If .Column = 1 Then
Application.EnableEvents = False
If InStr(1, .Value, ".") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ".", ",")

strText = .Value
For intPos = 1 To Len(strText)
If InStr(1, ",1234567890", LCase(Mid(strText, intPos, 1))) = 0 Then
MsgBox "nochmal"
Application.Undo
Exit For
End If
Next intPos
Application.EnableEvents = True
End If
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Eine Funktion, die die Ersetzungen durchführt, ist neben dem oben vorgeführten Substitute z. B.

Code:

Public Function dhTranslate( _
ByVal strIn As String, _
ByVal strMapIn As String, _
ByVal strMapOut As String, _
Optional lngCompare As VbCompareMethod = vbBinaryCompare) As String

' Take a list of characters in strMapIn, match them
' one-to-one in strMapOut, and perform a character
' replacement in strIn.

' From "VBA Developer's Handbook, 2nd Edition"
' by Ken Getz and Mike Gilbert
' Copyright 2001; Sybex, Inc. All rights reserved.

' In:
' strIn:
' String in which to perform replacements
' strMapIn:
' Map of characters to find
' strMapOut:
' Map of characters to replace. If the length
' of this string is shorter than that of strMapIn,
' use the final character in the string for all
' subsequent matches.
' If strMapOut is empty, just delete all the characters
' in strMapIn.
' If strMapOut is shorter than strMapIn, rightfill strMapOut
' with its final character. That is:
' dhTranslate(someString, "ABCDE", "X")
' is equivalent to
' dhTranslate(someString, "ABCDE", "XXXXX")
' That makes it simple to replace a bunch of characters with
' a single character.
' lngCompare (Optional, default is vbCompareBinary):
' Indicates how the search should compare values:
' vbBinaryCompare: case-sensitive
' vbTextCompare: case-insensitive
' vbDatabaseCompare (Doesn't work here)
' Any LocaleID value: compare as if in the selected locale.
' Out:
' Return Value:
' strIn, with appropriate replacements
' Example:
' dhTranslate("This is a test", "aeiou", "AEIOU") returns
' "ThIs Is A tEst"
' dhTranslate(someString, _
' "ÀÁÂÃÄÅÆàáâãäåæÈÉÊËèéêëÌÍÎÏìíîïÑñÒÓÔÕÖòóôõöØøÙÚÛÜùúûüÝýÿßÐ", _
' "AAAAAAAaaaaaaaEEEEeeeeIIIIiiiiNnOOOOOoooooOoUUUUuuuuYyysD")
' returns someString with 8-bit characters flattened
'
' Used by:
' dhExtractString
' dhExtractCollection
' dhTrimAll
' dhCountWords
' dhCountTokens

Dim lngI As Long
Dim lngPos As Long
Dim strChar As String * 1
Dim strOut As String

' If there's no list of characters
' to replace, there's no point going on
' with the work in this function.
If Len(strMapIn) > 0 Then
' Right-fill the strMapOut set.
If Len(strMapOut) > 0 Then
strMapOut = Left$(strMapOut & String(Len(strMapIn), _
Right$(strMapOut, 1)), Len(strMapIn))
End If

For lngI = 1 To Len(strIn)
strChar = Mid$(strIn, lngI, 1)
lngPos = InStr(1, strMapIn, strChar, lngCompare)
If lngPos > 0 Then
' If strMapOut is empty, this doesn't fail,
' because Mid handles empty strings gracefully.
strOut = strOut & Mid$(strMapOut, lngPos, 1)
Else
strOut = strOut & strChar
End If
Next lngI
End If
dhTranslate = strOut
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

User · 21. November 2007

Hi jinx

echt super wie du mir hilfst...
find ich echt gut :-)

Eine Kleinigkeit wäre da noch
Wenn ich mehrere Zelle makiere und dann entfernen drücke hengt sich das makro auf weil es scheinbar nicht weiß was es überprüfen soll...

Gibt es eine möglichkeit vorher zu prüfen ob die entfernen taste gedrückt wird und dann halt dem entsprechend die Prozedure zu übersrpingen?

Und nochmals danke für deine super Hilfe

MFG
XYZ Unbekannt

jinx · 21. November 2007

Moin, XYZ Unbekannt,

die Count-Eigenschaft nutzen - hier würde dann die erste Zelle links oben im Bereich ausgewählt:

Code:

If Target.Count > 1 Then
MsgBox "Nur eine Zelle markieren"
Target.Cells(1).Select
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wegen aller Nachfragen: ich hatte eine UserForm mit einer Textbox dafür empfohlen.

Zur eigentlichen Frage - man kann doch prüfen, ob der Inhalt der Zelle leer ist:

Code:

If IsEmpty(Target.Value) Then
MsgBox "Zelle ist leer"
Else
Msgbox "Hier besteht Handlungsbedarf"
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

User · 23. November 2007

So habe endlich mein Projekt fertig und das war das erstemal das ich mit Makros arbeiten ... und in VBA programmiert habe :-)

Hier ist mal mein Makro ... wird wahrscheinlich an manchen stellen etwas umständlich sein aber ich konnte mir an manchen stellen einfach nicht anderes Helfen ...

Code:

Dim intZaehler As Integer

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim strText As String
Dim intPos As Integer
Dim dblWert As Double

If intZaehler > 0 Then
GoTo hier
End If
If Target.Count > 1 Then
GoTo hier
End If
intZaehler = intZaehler + 1

With Target
If .Column = 2 Or .Column = 3 Or .Column = 4 Or .Column = 5 Then
Application.EnableEvents = False
strText = .Value
For intPos = 1 To Len(strText)
If InStr(1, .Value, ".") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ".", ",")
If InStr(1, .Value, ":") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ":", ",")
If InStr(1, .Value, ";") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ";", ",")
Next intPos

strText = .Value
For intPos = 1 To Len(strText)
If InStr(1, ",:.;1234567890", LCase(Mid(strText, intPos, 1))) = 0 Then
MsgBox "Fehler bei der Eingabe"
Application.Undo
Exit For
End If
Next intPos
Application.EnableEvents = True
If InStr(1, ",:.;1234567890", LCase(Mid(strText, intPos, 1))) 0 Then
strText = .Value
dblWert = CDbl(strText)
.Value = dblWert
GoTo hier
End If

End If
End With

hier:
intZaehler = 0

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und dir Jinx danke ich nochmals für deine super und schnelle Hilfe ...
Hättes das sonst nicht geschafft

MFG
XYZ Unbekannt

User · 23. November 2007

Ups das war nicht der letzte stand von meinem Projekt sondern folgendes ...

Code:

Dim intZaehler As Integer

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim strText As String
Dim intPos As Integer
Dim dblWert As Double

If Target.Count > 1 Or intZaehler > 0 Then
GoTo hier
End If
intZaehler = intZaehler + 1

With Target
If .Value = "" Then
GoTo hier
End If
If .Column = 2 Or .Column = 3 Or .Column = 4 Or .Column = 5 Then
Application.EnableEvents = False
strText = .Value
For intPos = 1 To Len(strText)
If InStr(1, .Value, ".") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ".", ",")
If InStr(1, .Value, ":") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ":", ",")
If InStr(1, .Value, ";") > 0 Then _
.Value = WorksheetFunction.Substitute(.Value, ";", ",")
Next intPos

strText = .Value
For intPos = 1 To Len(strText)
If InStr(1, ",:.;1234567890", LCase(Mid(strText, intPos, 1))) = 0 Then
MsgBox "Fehler bei der Eingabe"
Application.Undo
Exit For
End If
Next intPos
Application.EnableEvents = True
If InStr(1, ",:.;1234567890", LCase(Mid(strText, intPos, 1))) 0 Then
strText = .Value
dblWert = CDbl(strText)
.Value = dblWert
GoTo hier
End If

End If
End With

hier:
intZaehler = 0

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

MFG
XYZ Unbekannt

Office: (Office 2007) Gewisse Zeichen verhindern ...

Gewisse Zeichen verhindern ...

Gewisse Zeichen verhindern ...

Gewisse Zeichen verhindern ...

Gewisse Zeichen verhindern ...

Gewisse Zeichen verhindern ...

Gewisse Zeichen verhindern ... - Similar Threads - Gewisse Zeichen verhindern

Wenn gewisser Text im Outlook, dann in Spamordner

Komischer Zahlen in der GUI + VBA bestimmte Zellen mit gewissen Inhalt nicht löschen

E-Mails werden nach gewisser Zeit in Spam verschoben

Hinweis wenn gewisse Daten doppelt vorkommen

Popup bei gewisser auswahl im Combofeld

Gewisse Formularfelder als Mussfelder definieren

Personenliste, in der gewisse Daten automatisch wiederholt werden