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

Werte anpassen im Schlüssel

Forumthread: Werte anpassen im Schlüssel

Werte anpassen im Schlüssel
25.08.2017 13:50:29
Jens
Hallo,
ich habe in Spalte B ab Zeile 12 bis nach unten offen Daten stehen.
Aufgebaut sind die Daten z.b. so
U1_9_Z999_1.a
U2_10_Z.1.1.1
Das Trennzeichen kann variieren zwischen _ . / -
Nun soll es sein, dass egal welcher Schlüssel in welcher Länge da steht,
dass mit einem Makro in dem oben angegebenen Bereich so nachgebessert wird, dass
Zahlen nie einzeln geschrieben werden, sondern mindestens aus zwei Stellen.
d.h.
U01_09_Z999_01.a
U02_10_Z.01.01.01
Hat jemand eine Idee wie man das lösen kann?
Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: RegEx
25.08.2017 14:28:14
Fennek
Hallo,
ohne die Absicht, den Code zu schreiben:
Mit Regex kann man zuerst alle Zahlen extrahiere und dann auf die Länge (len()) prüfen. Falls len() = 1, gibt es auch den Replace-Befehl.
mfg
AW: RegEx
25.08.2017 14:57:46
Jens
Hallo
danke für den Tipp
https://www.vb-paradise.de/index.php/Thread/34042-RegEx-Tutorial-Blutige-Anf%C3%A4nger-und-Fortgeschrittene/
Irgendwie verstehe ich es aber nicht wie ich das machen soll sprich das ersetzen... wie soll ich da suchen nach Werten bzw Zahlen die blos einstellig dargestellt sind.
Anzeige
AW: RegEx
25.08.2017 15:24:13
Michael
Hallo Jens!
Mach Dir nichts draus, Fennek wirft gerne zuerst mit Begriffen um sich, anstatt gleich eine Lösung zu posten - finde ich auch nicht gut, v.a. bei Fragestellern wie Dir, die bereits angeben, dass sie kaum VBA-Kenntnisse haben.
Ich für meinen Teil kann Dir folgende Lösung anbieten, allerdings gebe ich Fennek insofern Recht, dass man sich weit effizientere Lösungen einfallen lassen könnte, dafür hab ich heute aber keinen Kopf und keine Lust mehr, daher hier eine quick-and-dirty-Lösung:
Sub a() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet Dim r As Range, c As Range, s$, i& Application.ScreenUpdating = False With Ws 'auf dem aktiven Tabellenblatt in 'B12:Bx (x = letzte gefüllte Zelle in B:B Set r = .Range(.Cells(12, "B"), .Cells(.Rows.Count, "B").End(xlUp)) For Each c In r With c For i = 1 To Len(.Text) If IsNumeric(Mid(.Text, i, 1)) Then If IsNumeric(Mid(.Text, i + 1, 1)) Then s = s & Mid(.Text, i, 1) Else: If IsNumeric(Mid(.Text, i - 1, 1)) Then s = s & Mid(.Text, i, 1) Else: s = s & CStr(0 & Mid(.Text, i, 1)) End If End If Else: s = s & Mid(.Text, i, 1) End If Next i 'Ausgabe in Nebenzelle .Offset(, 1) = s: s = vbNullString 'ODER Überschreiben der Ausgangszelle 'dann Anführungszeichen in nächster Zeile entfernen und 'Zeile mit .Offset löschen '.Value = s: s = vbnullstring End With Next c End With Set Wb = Nothing: Set Ws = Nothing: Set r = Nothing: Set c = Nothing End Sub Öffne mit [Alt] + [F11] den VBA-Editor, klicke auf Einfügen, Modul und kopiere den o.a. Code in das sich öffnende Fenster (Modul1). Mit F5 bzw. über die Excel-Menüleiste (Ansicht, Makros) kannst Du das Makro ausführen.
Der Code wirkt auf dem aktiven Blatt von B12:Bx, wobei x = die letzte gefüllte Zelle in B:B darstellt. Aktuell wird der korrigierte Zellwert in die rechte Nebenzelle geschrieben, wenn die Originalzelle ersetzt werden soll, musst Du eine Zeile löschen bzw. auskommentieren und eine andere aktiv setzen - ist im Code kommentiert.
LG
Michael
Anzeige
AW: Werte anpassen im Schlüssel
25.08.2017 17:14:27
ransi
HAllo Mario,
Fennek hat angedeutet.
Mit regex geht sowas recht gut.
Schau mal hier:
Tabelle1

 ABC
1U1_9_Z999_1.aU01_09_Z999_01.a 
2U2_10_Z.1.1.1U02_10_Z.01.01.01 
3   

Formeln der Tabelle
ZelleFormel
B1=machs(A1)
B2=machs(A2)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Function machs(strText) As String
    Dim regex As Object
    Dim objMatches As Object
    Dim objMatch As Object
    Dim strtmp As String
    strtmp = strText
    Set regex = CreateObject("vbScript.regexp")
    With regex
        .Pattern = "\D\d(?=\D)"
        .Global = True
        Set objMatches = .Execute(strText)
        For Each objMatch In objMatches
            strtmp = Replace(strtmp, objMatch, Left(objMatch, 1) & "0" & Right(objMatch, 1))
        Next
    End With
    machs = strtmp
End Function


ransi
Anzeige
AW: Werte anpassen im Schlüssel
25.08.2017 20:25:03
Fennek
Hallo,
auch wenn ransi einfach besser ist, ich hatte eine solche Lösung geplant:

Sub Start()
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "B") = iFen(Cells(i, "A"))
Next i
End Sub
Function iFen(Tx As String)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(\d+)"
Set RR = .Execute(Tx)
For i = 0 To RR.Count - 1
If RR(i).Length = 1 Then
Tx = Left(Tx, RR(i).firstindex + r) & "0" & Mid(Tx, RR(i).firstindex + 1 + r)
r = r + 1
End If
Next i
iFen = Tx
End With
End Function
mfg
Anzeige
AW: im zweiten Anlauf
25.08.2017 22:38:54
Fennek
Hallo,
eigentlich dachte ich an so etwas, aber nur mit ransi's Vorbild hat es im Beispiel funktioniert:

Sub Start2()
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "B") = iFen2(Cells(i, "A"))
Next i
End Sub
Function iFen2(ByVal Tx As String)
Tx = "Q" & Tx & "Q"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(\D)(\d)(\D)"
For Each RR In .Execute(Tx)
For Each R In RR.submatches
Tx = .Replace(Tx, "$10$2$3")
Next R
Next RR
Tx = Mid(Tx, 2, Len(Tx) - 2)
iFen2 = Tx
End With
End Function
mfg
Anzeige
AW: Warum?
26.08.2017 09:59:44
Fennek
ohne die loop wäre es ein kurzer Code geworden:

Function iFen3(ByVal Tx As String)
Tx = "Q" & Tx & "Q"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(\D)(\d)(\D)"
Do While .Test(Tx) '### ohne loop wird fast jede zweite NICHT getroffen ###
Tx = .Replace(Tx, "$10$2$3")
Loop
Tx = Mid(Tx, 2, Len(Tx) - 2)
iFen3 = Tx
End With
End Function

Anzeige
AW: Werte anpassen im Schlüssel
26.08.2017 11:03:31
Jens
Vielen Dank
Hat funktioniert :)

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige