Kommas korrigieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim objCell As Range, X As Variant, i As Integer On Error GoTo errExit For Each objCell In Target X = Split(objCell.Text, ",") If UBound(X) > 0 Then For i = 0 To UBound(X) X(i) = Trim$(X(i)) Next objCell.Value = Join(X, ", ") For i = 2 To Len(objCell.Value) - 1 If Mid(objCell.Value, i, 2) = ", " And _ IsNumeric(Mid(objCell.Value, i - 1, 1)) And _ IsNumeric(Mid(objCell.Value, i + 2, 1)) Then objCell.Value = Left(objCell.Value, i) & Mid(objCell.Value, i + 2, 999) i = i - 1 End If Next i End If Next errExit: End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim arrTmp Dim Regex As Object Dim objMatch As Object Dim raus As String Dim strText As String Dim objCell As Range On Error GoTo errExit For Each objCell In Target strText = Replace(objCell, " ", "") Set Regex = CreateObject("Vbscript.Regexp") With Regex .Pattern = "(\d+,\d+|\d+)" .Global = True Set objMatch = .Execute(strText) raus = objMatch(0).Value End With arrTmp = Split(strText, raus) arrTmp(0) = Replace(arrTmp(0), ",", ", ") arrTmp(1) = Replace(arrTmp(1), ",", ", ") raus = Replace(raus, "", " ") objCell = arrTmp(0) & raus & " " & arrTmp(1) Next errExit: End Sub

Hi Sven,
schau dir mal diese Tabelle an. Die Prozedur hat jeweils aus der oberen Zeile die nächste produziert.
Zur eindeutigen Darstellung hier im Web habe ich alle Leerzeichen durch "^" ersetzt.

	B
1	Text,Text,5,50^,^Arbeitsbuch^S.^4,5,6^,Arbeitsbuch^Nr.^4,5,6
2	Text,^Text,^5,50^,^Arbeitsbuch^S.^4,^5,^6^,^Arbeitsbuch^Nr.^4,^5,^6
3
4	Text,Text,5,50^,^Arbeitsbuch^S.^4,^5,^6^,Arbeitsbuch^Nr.^4,^5,^6
5	Text,^Text,^5,50^,^Arbeitsbuch^S.^4,^5,^6^,^Arbeitsbuch^Nr.^4,^5,^6
6
7	,abc
8	,^abc
9
10	ab,cd
11	ab,^cd
12
13	ab^,^^cd
14	ab^,^^cd
15
16	a,b,c
17	a,^b,^c
18
19	3,4,5
20	3,^4,^5
21
22	1,2,3
23	1,^2,^3
24
25	1,23/Std.
26	1,23^/Std.
27
28	1,23^^/Tag
29	1,^23^^/Tag
30
31	^^minus^1,^23^/Monat
32	^^minus^1,^23^/Monat
33
34	^^plus^1,2,7,89/Monat
35	^^plus^1,^2,^7,89^/Monat

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Welche dieser Beispiele laufen falsch? Gibt es weitere Beispiele, wo falsche Ergebnisse rauskommen?
Hier die Prozedur:


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngC As Range, arS As Variant, ii As Integer, strE As String
Dim pp As Long
For Each rngC In Target
If rngC.Row Mod 3 = 2 Then                ' nur jede 3. Zeile - Test!
strE = Replace(rngC.Text, ", ", "§$&/")
arS = Split(strE, ",")
If UBound(arS) > 0 Then
Application.EnableEvents = False
strE = Join(arS, ", ")
ii = InStr(strE, "")
Do While ii > 0
If ii > 4 Then
If Mid(strE, ii - 5, 5) Like "#, ##" Then
'                 strE = Left(strE, ii - 4) & Mid(strE, ii - 2)
strE = Left(strE, ii - 4) & Mid(strE, ii - 2, 2) _
& " " & Mid(strE, ii + 1)
ElseIf Mid(strE, ii - 6, 6) Like "#, ## " Then
strE = Left(strE, ii - 5) & Mid(strE, ii - 3)
End If
End If
ii = InStr(ii + 1, strE, "")
Loop
strE = Replace(strE, "§$&/", ", ")
rngC = strE
End If
End If                                    ' nur jede 3. Zeile - Test!
Next
Application.EnableEvents = True
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim rngC As Range, arS As Variant, ii As Integer, strE As String Dim pp As Long For Each rngC In Target If rngC.Row Mod 3 = 2 Then ' nur jede 3. Zeile - Test! strE = Replace(rngC.Text, ", ", "§$&/") arS = Split(strE, ",") If UBound(arS) > 0 Then Application.EnableEvents = False strE = Join(arS, ", ") ii = InStr(strE, "") Do While ii > 0 If ii > 4 Then If Mid(strE, ii - 5, 5) Like "#, ##" Then ' strE = Left(strE, ii - 4) & Mid(strE, ii - 2) strE = Left(strE, ii - 4) & Mid(strE, ii - 2, 2) _ & " " & Mid(strE, ii + 1) ElseIf Mid(strE, ii - 6, 6) Like "#, ## " Then strE = Left(strE, ii - 5) & Mid(strE, ii - 3) End If End If ii = InStr(ii + 1, strE, "") Loop strE = Replace(strE, "§$&/", ", ") rngC = strE End If End If ' nur jede 3. Zeile - Test! Next Application.EnableEvents = True End Sub

Hi Sven,
wegen dieser beiden Texte hättest du doch wirklich keine Mappe hochladen müssen.
^ statt Leerzeichen reicht für eine klare Darstellung der Texte hier aus.
Wichtiger ist, dass du dich mit dir selbst einigst, was wann rauskommen soll.
Aus inette^^S.^^^14 soll werden: inette^S.14
Aus Dapper^^^S.^^45 soll werden: Dapper^S.^45
Wonach richtet sich, dass hinter "S." mal ein Leerzeichen stehen bleiben soll, mal nicht?
Aus Nr.^4 soll werden: Nr.^4
Aus Nr.^^17 soll werden: Nr.17
Wonach richtet sich, dass hinter "Nr." mal ein Leerzeichen stehen bleiben soll, mal nicht?
Eine (jetzt für mich) neue Anfoderung ist, dass
aus 17^^-^^^20 jetzt 17-20 werden soll, also gar kein Leerzeichen stehen bleiben soll.
Normal käme derzeit 17^-^20 raus.
Was sollte jetzt z. B. aus 17^^-^^^20,15^ werden?
Was sollte jetzt z. B. aus Rabatt^^-^^^20,15^ werden?
Solange das Ziel nicht klar ist, lohnt keine Programmierung... :-(
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread