PDA

Vollständige Version anzeigen : IBAN in Vierblöcke aufteilen


Nobby5
04.07.2014, 13:07
Hallo liebe VBA-Profis,

ich habe folgendes Problem: In ein Überweisungsformular gebe ich in Zelle A8 die IBAN im Format z.B DE12720000000072002608 ein. Ich möchte aber das nach der Eingabe die IBAN so aufgeteilt wird: DE12 7200 0000 0072 0026 08 dafür benutze ich folgenden Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Application.EnableEvents = False
Dim lngLen As Long
Dim i As Long
Dim strTemp As String
Dim Eingang As String
Eingang = Target.Value
lngLen = Len(Eingang)
For i = 1 To lngLen Step 4
Str Temp = strTemp & Mid(Eingang, i, 4) & " "
Next i
Target.Value = Trim(strTemp)
Application.EnableEvents = True
End If
End Sub

Der Code funktioniert soweit ganz gut. Wenn ich aber den Zelleninhalt per

Private Sub CommandButton1_Click()
Range("A6,B8:F8").Select

Selection.ClearContents
Range("A6").Select
End Sub

lösche erhalte ich folgende Fehlermeldung: Typen unverträglich und im Debugger ist "Eingang = Target.Value" gelb markiert.

Lösche ich den Zellinhalt manuell mit der "Entf" Taste, funktioniert der IBAN-Code bei einer Neueingabe nicht mehr. Was mach ich nur falsch??

Ausserdem gebe ich die IBAN mit einem kleingeschriebenen "de" vorne ein und das hätte ich eigentlich lieber in Großbuchstaben, also "DE".

Es sieht vielleicht so aus als würde ich schon einiges von VBA verstehen, aber eigentlich "lese" ich mich nur durch Foren und benutze das Excel-Kompendium und die Hilfe in VBA. Daher wäre mir eine Antwort für Anfänger mit Fortgeschrittenen Ambitionen am hilfreichsten.

Vielen Dank im Voraus von Nobby5 :D

Mc Santa
04.07.2014, 13:17
Hallo,

probiere es mal so:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
With Target
.Value = _
Format(Replace(Right(.Value, Len(.Value) - 2), " ", ""), _
"!" & Left(.Value, 2) & "&& &&&& &&&& &&&& &&&& &&&& &&&& &&&& &&&&")
End With
End If
End Sub

Hilft dir das?
VG

EarlFred
04.07.2014, 13:19
Hallo Nobby5,

den Fehler kann ich nicht nachstellen. Ich vermute, Dein tatsächlicher Code sieht anders aus.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLen As Long
Dim i As Long
Dim strTemp As String
Dim Eingang As String
Dim c As Range


If Target.Column = 1 Then
Application.EnableEvents = False
For Each c In Intersect(Target, Me.Columns(1))
If Not IsEmpty(c) Then
Eingang = UCase(c.Value)
lngLen = Len(Eingang)
For i = 1 To lngLen Step 4
strTemp = strTemp & Mid(Eingang, i, 4) & " "
Next i
c.Value = Trim(strTemp)
End If
Next c
End If

Application.EnableEvents = True
End Sub


Private Sub CommandButton1_Click()
Range("A6,B8:F8").ClearContents
End Sub

Die Leerzeichen würde ich aber ohnehin nur als optischen Gag betrachten. Für mich gehören solche Daten ohne Leerzeichen gespeichert. Zudem sollte das Vorhandensein vor Leerzeichen geprüft werden, bevor weitere eingefügt werden.

Grüße
EarlFred

Nobby5
04.07.2014, 13:51
Hallo Mc Santa,

danke für Deine schnelle Antwort. ich habe Deinen Code in das Klassenmodul des Tabellenblatts kopiert. Bei der Eingabe wird die IBAN wie gewünscht aufgeteilt. Beim Löschen mit der "Entf" Taste und Neueingabe einer IBAN pasiert aber folgendes: Laufzeitfehler 5: Ungültiger Prozeduraufruf oder ungültiges Argument. Im Debugger ist
.Value = _
Format(Replace(Right(.Value, Len(.Value) - 2), " ", ""), _
"!" & Left(.Value, 2) & "&& &&&& &&&& &&&& &&&& &&&& &&&& &&&& &&&&")
gelb markiert.

Also ähnlich wie bei meinem Code, kann ich den Zellinhalt nicht problemlos löschen.:rolleyes:

Gruß Nobby

Nobby5
04.07.2014, 13:53
Danke EarlFred, aber ich habe den Code direkt aus meinem VBA kopiert. er sieht also tatsächlich so aus. Wie erwähnt funktioniert er auch bei der Ersteingabe in eine Zelle der Spalte 1 aber nach dem Entfernen, erhalte ich die Fehlermeldung :boah:

Nobby5
04.07.2014, 14:00
Nochmal für EarlFred
Habe gerade Deinen Code getestet. Vielen vielen Dank, nun funktioniert es auch, nachdem ich den Zellinhalt gelöscht habe :mrcool: Jetzt müsste ich nur noch wissen, wie ich das ursprünglich "kleingeschrieben" de in Großbuchstaben umwandeln kann. Ich hatte bei einem meiner ersten Versuche das hier gefunden: (strIBAN, ">&&&& &&&& &&&& &&&& &&&& &&"). Wo kann ich aber in Deinem Beispiel das > Zeichen einfügen ??

Mc Santa
04.07.2014, 14:00
Hallo,

sorry das stimmt, dann etwa so:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Value <> "" Then
With Target
.Value = _
Format(Replace(Right(.Value, Len(.Value) - 2), " ", ""), _
"!" & Left(.Value, 2) & "&& &&&& &&&& &&&& &&&& &&&& &&&& &&&& &&&&")
End With
End If
End Sub

Nobby5
04.07.2014, 14:24
Hi McSanta, Danke wieder für Deine Hilfe. Leider tritt jetzt ein neuer Laufzeitfehler auf. Die Aufteilung klappt perfekt, nach dem löschen mit VBA kommt: Laufzeitfehler 13, Typen unverträglich. Gelb im Debugger ist:
If Target.Column = 1 And Target.Value <> "" Then

Um Dir die Mühe zu ersparen habe ich selber gerade versucht herauszufinden was es mit dem fehler auf sich hat, aber dieser Fehler tritt ja in den unterschiedlichsten Variationen auf, also müsste ich Dich bitten nochmal in Dich zu gehen :)

Mc Santa
04.07.2014, 14:29
Bin gerade mobil online, daher ungetestet:
Umrahme den bisherigen Code wie folgt
Dim rng as Range
For each rng in Target

'Bisheriger Code

Next rng

Hoffe das hilft jetzt.
Vg

EarlFred
04.07.2014, 14:36
Hallo Nobby,

mein Code in Post #3 sollte ALLE Buchstaben groß schreiben, nicht nur DE.
Eingang = UCase(c.Value)

Grüße
EarlFred

Nobby5
04.07.2014, 14:48
Für MC Santa, vielen Dank für Deine mobile Hilfe. Da ich auch etwas lernen möchte werde ich nun selber versuchen das Problem zu lösen, denn auch dein letzter Hinweis brachte einen Fehler und ich möchte Dich nicht noch weiter strapazieren. Wenn ich überhaupt nicht mehr klar komm, poste ich wieder hier. :D

Für EarlFred: Deinen Code habe ich in einer leeren Arbeitsmappe getestet und da klappt alles wie gesagt einwandfrei. Füge ich ihn aber in die Datei ein in der ich das Feature gerne hätte passiert erstmal nichts. Da ich annehme der Fehlerteufel steckt in der Datei selbst, werde ich alles nochmal neu machen und dann weiter experimentieren und bevor ich dann den PC zerstöre weil ich nicht mehr weiterkomme melde ich mich wieder. (Nachtrag: Du hast recht mit den Großbuchstaben, das habe ich vor leuter Freude das ich endlich ohne Fehler löschen konnte garnicht bemerkt. Sorry ;-)

Danke euch beiden nochmal ganz herzlich.

EarlFred
04.07.2014, 14:58
Hallo Nobby,

der Code muss in das Codemodul des Tabellenblatts, dessen Eingaben Du überwachen willst. Vielleicht liegt schon da der Fehler.

Grüße
EarlFred

Nobby5
04.07.2014, 15:16
Hallo EarlFred, der Fehler liegt wohl auch mit daran, dass ich wirklich noch in den Kinderschuhen stehe und versuche mir mein Wissen durch Foren, dem Kompendium von Herrn Held und bedingungslosem Auspropieren (um nicht zu sagen fischen im Trüben) anzueignen. Deinen Code habe ich schon in das Klassenmodul des Tabellenblatts kopiert aber es hat sich nichts getan. Mittlerweile habe ich das Tabelllenblatt in eine neue Arbeitsmappe kopiert und dort sämtliche Makros die so drin sind überprüft und (nach bestem Wissen) bereinigt. Soweit so gut. Jetzt klappt auch Dein Code fehlerfrei und ich könnte zufrieden sein. Doch meinen ursprünglichen Code habe ich mir auch aus o.g Quellen zusammengebastelt und dabei eine wichtige Kleinigkeit übersehen: Bei dem ersten Code und Deinem wird ja die ganze Spalte 1 überwacht, ABER in meiner Datei möchte ich ja nur die Zelle A8 überwachen. (ich nehme an dazu brauch ich "Range"). Da aber immer eine Fehlermeldung beim löschen kam, ist mir das nie aufgefallen. erst jetzt wo Dein Code funktioniert habe ich bemerkt, das alle Zellen unter A8 nun auch aufgeteilt und Großgeschrieben werden :boah: Ich trau mich jetzt echt fast nicht zu fragen, ob Du mir noch ein einzigstes Mal hilfst und Deinen wunderbaren Code so änderst, das NUR Zelle A8 überwacht wird. :rolleyes:

EarlFred
04.07.2014, 15:36
Hallo,

klar, wenn Du so nett fragst:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLen As Long
Dim i As Long
Dim strTemp As String
Dim Eingang As String
Dim c As Range

Set c = Intersect(Target, Me.Range("A8"))

'Intersect(Target, Me.Range("A8"))
'Intersect bildet eine "Schnittmenge" aus dem
'TARGET = der geänderte Bereich, bestehend aus einer oder mehreren Zellen
'dem Bereich A8
'Wenn es eine Überschneidung dieses Bereiches gibt, gibt Intersect diesen
'"Schnittmengenbereich" zurück.
'Gibt es keine Schnittmenge, ist die Rückgabe Nothing
'(das ist eine Besonderheit bei Objekten. Keine Ahnung, ob das in Deiner
'Literatur behandelt wird. Schlage bitte dort zuerst nach.)
'Die Schnittmenge wird der Variablen "c" zugewiesen.
'c ist als "Range" deklariert, kann also einen Bereich eines Arbeitsblattes aufnehmen.

If Not c Is Nothing Then
'Wenn c nicht leer ist (also "etwas" drinsteht"), dann...
If Not IsEmpty(c) Then
'Dein Codem bezogen auf c
Application.EnableEvents = False
Eingang = UCase(c.Value)
lngLen = Len(Eingang)
For i = 1 To lngLen Step 4
strTemp = strTemp & Mid(Eingang, i, 4) & " "
Next i
c.Value = Trim(strTemp)
End If
End If

'Variable c "leeren"
Set c = Nothing
Application.EnableEvents = True
End Sub

Hab sogar ein paar erläuternde Worte hinzugefügt. Frag, wenn etwas unklar ist.

Grüße
EarlFred

Nobby5
04.07.2014, 16:35
Hallo EarlFred,
also nun bin ich echt sprachlos. Zum einen funktioniert jetzt alles wirklich tadellos und zum anderen hast Du Dir auch noch die Zeit genommen mir den teil des Codes zu erläutern. Das ist wirklich wahnsinnig nett von Dir und ich habe für mich schon etwas dazu gelernt. Megaherzlichen Dank für Deine Mühe und die zeit die Du dafür geopfert hast. Ich werde Deinen Rat befolgen und in meinem Kompendium nachlesen. Du warst mir wirklich eine sehr große Hilfe und gäbe es hier eine Bewertung, würdest Du noch ein extra Sternchen von mir bekommen. Wenn ich wieder an meine Grenzen stoße hoffe ich auf Dich zu treffen, denn bei Dir bin ich mir sicher, dass Du mir helfen kannst und zwar auf eine mehr als nette Art. Vielen herzlichen Dank, hoffentlich bis bald mal wieder und viel Erfolg bei Deinen weiteren Programmierungen!
Gruß Nobby ;)