Danke Andi & Uwe
25.10.2006 13:37:23
abu
habe letzte Woche bereits diese Anfrage gestartet und ganz tolle Hilfe von Andi und Uwe erhalten. Leider konnte ich mich an der Runde nicht mehr beteiligen und so haben beide Lösungen ausgemacht mit den ich leider nicht zurecht kommen (Danke euch beiden!) und hier nochmal fragen muß... Hier noch mal kurz das Problem und der bisherige Ansatz, anschließend meine Fragen:
Problem:
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 "]]" von rechts gesehen, dann fang an zu löschen bis "[[" kommt, dann schreibe zwischen "[[]]" den Wert aus A1 und ersetze jedes Leerzeichen durch "+".
Springe in die nächste Zeile, mache das gleiche bis Zelle An keinen Wert hat.
Lösungsansätze:
Ich erlaube mir hier Andi's Antwort vorzugreifen, ohne sie entbehrlich werden zu lassen:
<pre>
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</pre>
~f~
und die Ändrung in der <pre>
<pre>
Function (der Test für die Forderung "TAGs erhalt", führte zur weiteren Korrekturen:
~f~
<pre>
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</pre>
Meine Fragen:
Ist es richtig wenn ich den Code einfach so hintereinander in den Editor schreibe?
Im Moment schreibt er das Ergebnis in Zelle B2, sollte aber in B1 landen also das alte ersetzen.
Wenn die Kommentarapostrophe weg mache sollte er doch einfach in die nächste Zeile gehen, findet er einen Wert, dann läuft die Schleife noch mal findet er nichts dann hört er auf... Er gibt aber immer eine Fehlermeldung raus bei Next A, warum?
Freue mich über jegliche Hilfe. Danke im Voraus.
LG
abu