02.04.2017, 13:30 (Dieser Beitrag wurde zuletzt bearbeitet: 02.04.2017, 13:30 von Leo223excel.)
.hallo,
Ja dein code funktioniert und er deckt auch vieles was ich machen will ab
Meine Beispieldatei ist auch so wie das Orginal aufgebaut. Ob meine Daten in spalte C oder in A stehen ist eigentlich egal. Ich wollte deinen code verstehen, was in den codezeilen gemacht wird. Dann kann man kleinere änderungen selbst vornehmen. Bei der sache mit der spalte müsste sicher nur eine 1 durch eine 3 ersetzt werden.
Hab ich wirklich geschrieben dass deine Lösung nicht funktioniert und es bei mir ganz anders aussieht? Ich komme nicht mit neuen Problemen; nein. Ich weiss dass Excel nicht alles kann. Den code hab ich übernommen und es klappt. Mein Gedanke war, man könnte hier und da evtl noch was machen. Solche ideen kommen eben manchmal später wenn man einen code schreiben will, aber muss nicht unbedingt sein. Hat nichts damit zu tun dass dein Vorschlag komplett falsch ist.
02.04.2017, 18:36 (Dieser Beitrag wurde zuletzt bearbeitet: 02.04.2017, 18:38 von Leo223excel.)
Dann sollte ja alles in Ordnung sein. Also nochmal danke für die Mühe und ich lass den code so wie er ist. Die Begriffe die am ende rauskommen sollen verwende ich wieder woanders, deswegen spielt das keine große Rolle in welcher Spalte sie stehen.
Danke auch dafür, dass du mir noch weiterhelfen willst. Ich hab gerade gesehen, dass es in meiner Liste noch Zahlen gibt vor denen ein Buchstabe steht. Da steht nicht 500, sondern Z500 (Lenovo Laptop). Wenn ich deinen Code ausführe erhalte ich die Fehlermeldung Laufzeitfehler 'siehe Bild'. Kannst du dir das nochmal ansehen, wenn du zeit dafür hast.
Ich weiss dass es bei meiner Liste einige Sonderfälle gibt, is auch nicht schlimm wenn nicht alles richtig ersetzt wird. Aber ein großer Teil wird mit deinem Code schon richtig ersetzt. Ich hab die Zeile gelb markiert (Stutt-CompZ500, soll in B8 stehen).
02.04.2017, 19:32 (Dieser Beitrag wurde zuletzt bearbeitet: 02.04.2017, 19:33 von atilla.)
Hallo,
dann teste mal folgendes:
Code:
Sub suchen_ersetzen()
Dim i As Long, j As Long, n As Long, p As Long
Dim lngZSuch As Long
Dim lngZErgebnis As Long
Dim suchT As String, strgZahl As String
Dim ati, atti, varT
Dim at()
With Sheets("Suchbegriffe")
lngZSuch = .Cells(Rows.Count, 1).End(xlUp).Row
ati = .Range("A2:B" & lngZSuch) 'Bereich in dem die Suchbegriffe und ihr Ersatz stehen
End With
With Sheets("Tabelle1")
lngZErgebnis = .Cells(Rows.Count, 1).End(xlUp).Row
Range("B3:B" & lngZErgebnis).ClearContents 'Bereich in dem geschrieben wird
atti = Range("A3:A" & lngZErgebnis) 'Bereich in dem gesucht wird
ReDim at(lngZErgebnis - 3, 0)
For i = LBound(ati) To UBound(ati)
varT = Split(ati(i, 1))
suchT = "*" & Join(varT, "*") & "*"
For j = 1 To lngZErgebnis - 2
If atti(j, 1) Like suchT Then
varT = Split(atti(j, 1))
For n = UBound(varT) To LBound(varT) Step -1
If (varT(n)) Like "*" & "[0-9]" & "*" Then
For p = 1 To Len(varT(n))
If IsNumeric(Mid(varT(n), p, 1)) Then strgZahl = strgZahl & Mid(varT(n), p, 1)
Next p
Exit For
End If
Next n
at(j - 1, 0) = ati(i, 2) & "-" & Mid(strgZahl, 1)
strgZahl = ""
End If
Next j
Next i
.Range("B3:B" & lngZErgebnis) = at 'Bereich in dem geschrieben wird
End With
Beachte die Kommentare im Code. Die helfen Dir bei nötiger Anpassung.
hier noch eine Version, die vielleicht noch sicherer ist.
Es wird immer die letzte Zahl genommen, wenn mehrere Zahlen vorkommen.
Code:
Sub suchen_ersetzen2()
Dim i As Long, j As Long, n As Long, p As Long
Dim lngZSuch As Long
Dim lngZErgebnis As Long
Dim suchT As String, strgZahl As String
Dim ati, atti, varT
Dim at()
With Sheets("Suchbegriffe")
lngZSuch = .Cells(Rows.Count, 1).End(xlUp).Row
ati = .Range("A2:B" & lngZSuch) 'Bereich in dem die Suchbegriffe und ihr Ersatz stehen
End With
With Sheets("Tabelle1")
lngZErgebnis = .Cells(Rows.Count, 1).End(xlUp).Row
Range("B3:B" & lngZErgebnis).ClearContents 'Bereich in dem geschrieben wird
atti = Range("A3:A" & lngZErgebnis) 'Bereich in dem gesucht wird
ReDim at(lngZErgebnis - 3, 0)
For i = LBound(ati) To UBound(ati)
varT = Split(ati(i, 1))
suchT = "*" & Join(varT, "*") & "*"
For j = 1 To lngZErgebnis - 2
If atti(j, 1) Like suchT Then
For n = Len(atti(j, 1)) To 1 Step -1
If IsNumeric(Mid(atti(j, 1), n, 1)) Then
p = n
Do Until Not IsNumeric(Mid(atti(j, 1), p, 1)) Or p = 1
p = p - 1
Loop
Exit For
End If
Next n
at(j - 1, 0) = ati(i, 2) & "-" & Mid(atti(j, 1), p + 1, n - p)
strgZahl = ""
End If
Next j
Next i
.Range("B3:B" & lngZErgebnis) = at 'Bereich in dem geschrieben wird
End With
09.04.2017, 18:36 (Dieser Beitrag wurde zuletzt bearbeitet: 09.04.2017, 18:37 von Leo223excel.)
Hallo Attila,
ich verwende deinen Code und ich kann ihn auch bei sehr vielen Tabellen anwenden, doch leider nicht bei allen. Es ist so:
Wenn in der Spalte in der gesucht werden soll zweimal der gleiche Text erscheint, dann kommt bei Ausführung des Codes eine Fehlermeldung (ungültiger Prozeduraufruf). Das gleiche passiert auch wenn in einer Zelle nur "München" steht. Ich hab versucht den Fehler selbst zu korrigieren, das hat leider nicht geklappt. Deswegen möchte ich dich nochmal fragen ob du mir weiterhelfen kannst. Markiert wird mir im Code die Zeile:
at(j - 1, 0) = ws(i, 2) & "-" & Mid(wsT(j, 1), p + 1, n - p)
hier ist meine excel datei. Vielleicht kannst du dir das nochmal ansehen.
Sub suchen_ersetzen2()
Dim boVar As Boolean
Dim i As Long, j As Long, n As Long, p As Long
Dim lngZSuch As Long
Dim lngZErgebnis As Long
Dim suchT As String, strgZahl As String
Dim ws, wsT, varT
Dim at()
With Sheets("Suchbegriffe")
lngZSuch = .Cells(Rows.Count, 1).End(xlUp).Row
ws = .Range("A2:B" & lngZSuch) 'Bereich in dem die Suchbegriffe und ihr Ersatz stehen
End With
With Sheets("Daten")
lngZErgebnis = .Cells(Rows.Count, 3).End(xlUp).Row
Range("A2:A" & lngZErgebnis).ClearContents 'Bereich in dem geschrieben wird
wsT = Range("C2:C" & lngZErgebnis) 'Bereich in dem gesucht wird
ReDim at(lngZErgebnis - 3, 0)
For i = LBound(ws) To UBound(ws)
varT = Split(ws(i, 1))
suchT = "*" & Join(varT, "*") & "*"
For j = 1 To lngZErgebnis - 2
If wsT(j, 1) Like suchT Then
boVar = True
For n = Len(wsT(j, 1)) To 1 Step -1
If IsNumeric(Mid(wsT(j, 1), n, 1)) Then
p = n
Do Until Not IsNumeric(Mid(wsT(j, 1), p, 1)) Or p = 1
p = p - 1
Loop
Exit For
End If
Next n
If n > p Then
at(j - 1, 0) = ws(i, 2) & "-" & Mid(wsT(j, 1), p + 1, n - p)
Else
If boVar Then at(j - 1, 0) = ws(i, 2)
End If
strgZahl = ""
End If
Next j
Next i
.Range("A3:A" & lngZErgebnis) = at 'Bereich in dem geschrieben wird
End With
End Sub
Ich schreib extra "in diesem Fall", da es immer unterschiedliche Konstellationen sind.
Bei einer anderen Konstellation kann es wieder andere Probleme geben.
ich habe noch einen Vorschlag zum Thema die Spalten zum Suchen und auflisten frei zu waehlen.
Man kann die gewünschten Spalten als Const mit dem Spalten Buchstaben angeben. Hier meine Idee
Der normale Code bleibt davon unberührt.
mfg Gast 123
Code:
Option Explicit
Const SR = "C" 'SuchRange - Spalte in Daten zum suchen
Const LR = "A" 'ListRange - Spalte in Daten zum auflisten
'ab hier die alten Zuweisungen aendern !!
With Sheets("Daten")
lngZErgebnis = .Cells(Rows.Count, SR).End(xlUp).Row
.Range(LR & "2:" & LR & lngZErgebnis).ClearContents 'Bereich in dem geschrieben wird
wsT = Range(SR & "2:" & SR & lngZErgebnis) 'Bereich in dem gesucht wird
ReDim at(lngZErgebnis - 3, 0)
Next i
'Ende: Bereich der Auswertung aendern
.Range(LR & "2:" & LR & lngZErgebnis) = at 'Bereich in dem geschrieben wird
