VBA Textteile finden, ausschneiden in andere Zelle einfügen

[Klaus]

:18:

japp... das klappt. Der Code bastelt zwar die Komma mit in das Feld... aber das krieg ich glaub ich schon hin.
wenn nicht ist mir das auch recht  :19:


Allerbesten Dank

[Klaus]

Hallo Attila,

habe Deinen Code auch mal probiert. Hier landet jeweils ein Suchwort in "F". Überschrieben wird beim zweiten Klick aber nichts mehr.

Was meinst Du mit anpassen?

Viele Grüße
Klaus

[atilla]

Hallo,

ok, Kommando zurück. War nicht ausgereift das Ganze.

[Klaus]

Ok... Atilla... dafür funktioniert aber schon ziemlich gut  :17:

Fennek bei Deinem Code wird seltsamerweise eine Kombination nicht erkannt...

"Bus/ Text kommt hier" wird nicht erkannt. Hier entfernt er nichts.
"Bus/Bus Text kommt hier" wird aber erkannt. Hier entfernt er beide Busse.

Ich hab mal versucht das hiermit auszumerzen... eh... klappt nicht...  :16:

Code:

Mob = Array("Bus", "Bahn", "Auto", "Bus/", "Bahn/", "Auto/")

Der Code vom Atilla killt den "Bus/" - aber hier wird eben nur eines der Suchwörter an "F" weiter gegeben...
Hm...
Ich glaub hier muss ne Mütze Schlaf drüber ...

Liebe Grüße
Klaus

[atilla]

Hallo,

mit folgendem Code:

Code:

Sub ZeichenTauschen()
Dim lngZ As Long, i As Long, j As Long
Dim Zelle As Range
Dim SuchenNach
Dim ErsetzenDurch As String
SuchenNach = Array("BUS", "Bahn", "Auto")
ErsetzenDurch = ""
lngZ = Cells(Rows.Count, 4).End(xlUp).Row

For i = 1 To lngZ
 For j = LBound(SuchenNach) To UBound(SuchenNach)
   If InStr(Cells(i, 4).Value, SuchenNach(j)) Then
     Cells(i, 6) = SuchenNach(j) & ", " & Cells(i, 6)
     Cells(i, 4).Value = Replace(Cells(i, 4).Value, SuchenNach(j), ErsetzenDurch)
   End If
Next j
Next i

End Sub

erhalte ich bei dieser Gegebenheit:

Arbeitsblatt mit dem Namen 'Tabelle2'
	D
1	Das  Auto und die Bahn  aber keine Busse
2	die Busse und Autos und die Bahn
3	Die Bahn  braucht eine Bahnfahrkarte, Autos und BUSSE nicht

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

folgendes Ergebnis nach Code-Ausführung:

Arbeitsblatt mit dem Namen 'Tabelle2'
	D	E	F
1	Das   und die   aber keine Busse		Auto, Bahn,
2	die Busse und s und die		Auto, Bahn,
3	Die   braucht eine fahrkarte, s und SE nicht		Auto, Bahn, BUS,

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

[Klaus]

Hallo Atilla,

wunderbar, der Code funktioniert tadellos. Dauert ein bisschen bis er die 5000er Marke geknackt hat - aber das Ergebnis ist genauso wie es sein soll. 
Perfekt. 

Ich würde gern so ähnlich auch noch zwei andere Spalten filtern.
Allerdings hier etwas andere Anforderungen.


In Spalte "J" soll die Textpassage "siehe Text!" entfernt werden. Der Restliche Textinhalt der Spalte soll so bleiben wie er ist.
Das Problem hierbei - es wird manchmal zusammen, manchmal groß, manchmal klein, manchmal mitten im Wort ein großer Buchstabe, manchmal mit und manchmal ohne Ausrufezeichen geschrieben.
Möglich ist z.B.: 
sieheText, Siehe TEXT, siehe teXt... wahllos kombiniert mit und ohne Ausrufezeichen oder Punkt...

In Spalte "K" sollten alle Sonderzeichen (eigentlich nur "Leerzeichen", "/" , "-", ) VOR dem eigentlichen Text entfernt werden. In der Regel sind das die ersten 5-8 Zeichen. Im Text selbst dürfen diese Zeichen nicht entfernt werden...

Könnte man das auch realisieren?

Liebe Grüße
Klaus

[atilla]

Hallo,

den vorigen Code kann man ein wenig schneller machen:

Code:

Sub ZeichenTauschen()
 Dim lngZ As Long, i As Long, j As Long
 Dim Zelle As Range
 Dim SuchenNach
 Dim ErsetzenDurch As String
 Dim feld
 SuchenNach = Array("BUS", "Bahn", "Auto")
 ErsetzenDurch = ""
 lngZ = Cells(Rows.Count, 4).End(xlUp).Row
 feld = Range("D1:F" & lngZ)
 For i = 1 To lngZ
  For j = LBound(SuchenNach) To UBound(SuchenNach)
    If InStr(feld(i, 1), SuchenNach(j)) Then
      feld(i, 2) = SuchenNach(j) & ", " & feld(i, 2)
      feld(i, 1) = Replace(feld(i, 1), SuchenNach(j), ErsetzenDurch)
    End If
 Next j
 Next i
 Range("D1:F" & lngZ) = feld
End Sub

Müssen bei der jetzt angefragten Suche die Funde auch in eine separaten Spalte?
Wenn nicht, müsste es leichter und schneller gehen. Im Grunde könntest Du das auch selber aufzeichnen mit dem Rekorder.
In der Menüleiste Start und der Gruppe Bearbeiten einfach Suchen und ersetzen wählen und mit den gegebenen Optionen spielen.

[Klaus]

Hallo Atilla,

das ist jetzt wirklich schnell der Code flitzt ja nur so durch.

Danke für den Tip mit dem Recorder. Ich werde basteln
Leider klappt das mit den Sonderzeichen welche nur vor dem Text entfernt werden sollen mit der Suchen/Ersetzen Hausvariante von Excel nicht. Die klaut mir alle Zeichen aus dem gesamten Text 

Nein. Hier würden alle Spalten so bleiben wie sie sind. Nur besagte Stellen daraus entfernen. Nichts kopieren, nichts verschieben...

Viele Grüße
Klaus

[atilla]

Hallo Klaus,

Spalte J geht eigentlich relativ schmerzlos:

Code:

Sub spalte_J()
 Dim lngZ As Long, j As Long

 Dim SuchenNach
 Dim ErsetzenDurch As String
 SuchenNach = Array("siehetext", "siehetext!", "siehe text", "siehe text!")
 ErsetzenDurch = ""
 lngZ = Cells(Rows.Count, 10).End(xlUp).Row
  For j = LBound(SuchenNach) To UBound(SuchenNach)
      Range("J1:J" & lngZ).Replace What:=SuchenNach(j), Replacement:=ErsetzenDurch, LookAt:=xlPart, SearchOrder _
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 Next j
End Sub

Groß-und Kleinschreibung wird nicht beachtet. Falls Du weitere Kombinationen eintragen musst, kannst Du also alles groß oder klein schreiben.


Die Sonderzeichen gehen nicht so einfach.
Das könnte mit Regular Expressions vielleicht einfach zu lösen sein. Doch leider kenne ich mich damit nicht aus.

Ich kann Dir eine Lösung mit Schleifen bieten, wobei ich den Anfang des Textes Zeichen für Zeichen untersuche.
Dazu müsste ich aber detailliertere Angabe über mögliche Zeichenfolgen haben. Wenn es immer Max bis Zeichen 8 geht müsste ich das auch wissen.

[Klaus]

Guten Abend Atilla,

besten Dank für Deine Hilfe.
Klappt wunderbar  :19:

Liebe Grüße
Klaus