Finde Stelle, lösche und ersetze

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim a As Long For a = 1 To Range("A65536").End(xlUp).Row Cells(a, 2) = Left(Cells(a, 2), InStrRev(Cells(a, 2), "[")) & Cells(a, 1) & Right(Cells(a, 2), Len(Cells(a, 2)) - (InStrRev(Cells(a, 2), "]") - 2)) Next a End Sub

Hallo Andi,
hab glücklicherweise doch noch die Info's vor dem Wochenende bekommen. ich geb dir mal ein Beispiel so kann man glaube ich am besten erkennen was Sache ist:
In Zelle A1 steht:
kuechenrollenhalter online kauf
In Zelle A2 steht:
http://www.xxx.de/xxxTracking?tid=157053C157S157052CL30PPC&url=[[http://www.xxxxx.de/bp/search.htm?qu=939730J&landmark=Entry&wkz=87&iwl=975&typ=SEM&anbieter=xxx&aktion=Keyword&version=ohne&promo=kuechenrollenhalter+online+kauf]]&kw=[[kuechenrollenhalter]]xyz
Mein Code soll das daraus machen:
http://www.xxx.de/xxxTracking?tid=157053C157S157052CL30PPC&url=[[http://www.xxxxx.de/bp/search.htm?qu=939730J&landmark=Entry&wkz=87&iwl=975&typ=SEM&anbieter=xxx&aktion=Keyword&version=ohne&promo=kuechenrollenhalter+online+kauf]]&kw=[[kuechenrollenhalter+online+kauf]]xyz
Also finde die ersten 2 "]]", dann fang an zu löschen bis "[[" kommt, dann schreibe zwischen "[[]]" den Wert aus A1 und ersetze jedes Leerzeichen durch "+".
So ich hoffe ich habe damit klarheit geschaffen, ansonsten stehe ich gerne für Fragen zur Verfügung.
Gruß
Abu

Sub t() Dim a As Long 'For a = 1 To Range("A65536").End(xlUp).Row a = 1 Cells(a + 1, 2) = Left(Cells(a, 2), InStrRev(Cells(a, 2), "[")) & Replace(Cells(a, 1), " ", "+") & Right(Cells(a, 2), Len(Cells(a, 2)) - (InStrRev(Cells(a, 2), "]") - 2)) 'Next a End Sub

Function ReplaceTextBereich(strOrigi As String, strNew As String, _ Optional strTag0 As String = "[[", _ Optional strTag1 As String = "]]", _ Optional direction As Integer = -1) As String Dim pos0 As Integer, pos1 As Integer, tpos As Integer, strTxtChg As String pos0 = InStr(strOrigi, strTag0) pos1 = InStr(strOrigi, strTag1) If direction < 0 Then Do tpos = InStr(pos0 + Len(strTag0), strOrigi, strTag0) If tpos > 0 Then pos0 = tpos Loop Until tpos = 0 Do tpos = InStr(pos1 + Len(strTag1), strOrigi, strTag1) If tpos > 0 Then pos1 = tpos Loop Until tpos = 0 End If If pos0 > 0 And _ pos1 > 0 And _ pos0 < pos1 Then strTxtChg = Mid(strOrigi, _ pos0, _ (pos1 - pos0) + Len(strTag1)) 'Tags bleiben erhalten ReplaceTextBereich = Replace(strOrigi, _ strTxtChg, _ strTag0 & Replace(strNew, " ", "+") & strTag1) Else ReplaceTextBereich = strOrigi End If End Function

Sub t() Dim a As Long For a = 1 To Range("A65536").End(xlUp).Row Cells(a, 2) = Left(Cells(a, 2), InStrRev(Cells(a, 2), "[")) & Replace(Cells(a, 1), " ", "+") & Right(Cells(a, 2), Len(Cells(a, 2)) - (InStrRev(Cells(a, 2), "]") - 2)) Next a End Sub

Hallo, Abu,
als Grundgerüst kann ich Dir folgende Funktion anbieten:

Option Explicit
Function ReplaceTextBereich(strOrigi As String, strNew As String, _
Optional strTag0 As String = "[[", _
Optional strTag1 As String = "]]", _
Optional direction As Integer = -1) As String
Dim pos0 As Integer, pos1 As Integer, tpos As Integer, strTxtChg As String
pos0 = InStr(strOrigi, strTag0)
pos1 = InStr(strOrigi, strTag1)
If direction < 0 Then
Do
tpos = InStr(pos0 + Len(strTag0), strOrigi, strTag0)
If tpos > 0 Then pos0 = tpos
Loop Until tpos = 0
Do
tpos = InStr(pos1 + Len(strTag1), strOrigi, strTag1)
If tpos > 0 Then pos1 = tpos
Loop Until tpos = 0
End If
If pos0 > 0 And _
pos1 > 0 And _
pos0 < pos1 Then
'            strTxtChg = Mid(strOrigi, _
'                       pos0 + Len(pos0), _
'                       (pos1 - pos0) - Len(strTag1)) 'Tags bleiben erhalten
strTxtChg = Mid(strOrigi, _
pos0, _
(pos1 - pos0) + Len(strTag0)) 'Tags werden mit ersetzt erhalten
ReplaceTextBereich = Replace(strOrigi, strTxtChg, strNew)
Else
ReplaceTextBereich = strOrigi
End If
End Function

Sie Ersetzt wahlweise den Text zwischen zwei unterschiedlichen Tag (z.B. [TAG1] .... [TAG2], oder eben [[ ... ]]. die Fragen von @Andi sind je nach Antwort erfordern ggf. eine zusätzliche besondere Abfragelogik.
Aufrufen kannst Du die Funktion in einer Zellenfunktion
(für das Suchen vom Textende): =ReplaceTextBereich(B1;A1;"[[";"]]";-1)
oder =ReplaceTextBereich(B1;A1;"[[";"]]")
oder =ReplaceTextBereich(B1;A1)
(für das Suchen vom Textanfang): =ReplaceTextBereich(B1;A1;"[[";"]]";1)
Der Ersetzungsvorgang wird nur ausgelöst, wenn die Position TAG0 vor der Position von TAG1 liegt.
Mit Direcktion wird der Suchbegin im Text definiert:
Größer Null oder ohne Angabe: vom Textanfang
Kleiner Nul: vom Textende
Ist die Position Position von TAG0 größer als die von TAG1, wird keine Textersetung vorgenommen.
Zu klären bleibt, ob die TAGs erhalten bleiben sollen oder nicht. Ich habe die eine Möglichkeit von beiden auskommentiert.
Wenn Dein e Aufgabe nur für die festen Begrenzer [[ und ]] gilt und die Suchrichtung immer vom Textende her erfolgen soll, dann können natürlich die entsprechenden Aufrufparameter durch feste Werte in der Funktion ersetz werden.
Gruß,
Uwe

Beliebteste Forumthreads (12 Monate)

Finde Stelle, lösche und ersetze

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread