Bereinigung von Feldern über VBA

Hallo zusammen,
ich habe folgendes Problem: In meiner Excel-Datei ist der Textinhalt einiger Felder nicht ganz sauber, da sie neben Text auch Zahlen enthalten. Diese Zahlen sollen verschwinden. Allerdings sind die Felder auch nummeriert und die Nummerierung soll beibehalten werden.
Leider treten die Zahlen unterschiedlich in den Feldern auf, also nicht immer an der gleichen Stelle, somit kann das (meines Wissens nach) nicht über ein Trimm gelöst werden.
Ich benötige für meinen Fall ein VBA Skript, welches bei der Kombination "Buchstabe und Zahl" die Zahl rausschmeißt, bei der Kombination "Zahl und ." die Zellinhalte so lässt.
Hat jemand eine Idee, wie das gelöst werden kann?
Eine beispielhafte Exceldatei mit Soll und Ist Spalte habe ich hinzugefügt.
https://www.herber.de/bbs/user/154377.xlsx
Vielen Dank im Voraus!
Johannes

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub F_en() Dim Tx As String For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row pos = InStr(1, Cells(i, 1), Chr(32)) If pos Then For b = pos To Len(Cells(i, 1)) If Mid(Cells(i, 1), b, 1) Like "#" Then Else Tx = Tx & Mid(Cells(i, 1), b, 1) End If Next b Cells(i, 6) = Left(Cells(i, 1), pos) & Tx Tx = "" End If Next i End Sub

Hallo
ich habs mal zweigeteilt
das erste ist die Funktion, die die Aufgabe erledigt.
du könntest diese Funktion auch in einer Formel in einer Zelle einsetzen


=Zahlenraus(A3)

dazu dieser Code in einem allgemeinen Modul.
die Umwandlung erfolgt ab dem letzten Punkt im Text. die Zahlen die vor dem letzten Punkt stehen, bleiben erhalten:


Function ZahlenRaus(txt As String) As String
Dim i As Long
Dim T As String
For i = Len(txt) To 1 Step -1
T = Mid(txt, i, 1)
If T = "." Then Exit For
If Not T Like "#" Then ZahlenRaus = T & ZahlenRaus
Next
If i > 0 Then ZahlenRaus = Left(txt, i) & ZahlenRaus
End Function

dieses Makro macht dann die Umwandlung mit hilfe der Funktion im selektierten Zellbreich:


Sub Ausführen()
Dim Zelle As Range
For Each Zelle In Selection.SpecialCells(xlCellTypeConstants, 2)
Zelle.Value = ZahlenRaus(Zelle.Value)
Next
End Sub

also beide Codes in ein allgemeines Modul kopieren, zellen markieren und dann das Makro Auswühren starten.
Gruß Daniel

Function ZahlenRaus(txt As String) As String Dim Pos1 As Long Dim i As Long Dim T As String Pos1 = InStr(txt, " ") + 1 If Pos1 > 1 Then ZahlenRaus = Left(txt, Pos1) For i = Pos1 + 1 To Len(txt) T = Mid(txt, i, 1) If Not T Like "#" Then ZahlenRaus = ZahlenRaus & T Next End Function

Sub Makro1() Application.EnableEvents = False ActiveCell.FormulaLocal = _ "=LINKS(A3;FINDEN(""."";A3;SUMMENPRODUKT((TEIL(A3;SPALTE($1:$1);1)=""."")*1)*2)+1)&RemoveNumbers(TEIL(A3;FINDEN(""."";A3;SUMMENPRODUKT((TEIL(A3;SPALTE($1:$1);1)=""."")*1)*2)+2;50))" Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

Bereinigung von Feldern über VBA

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread