02.04.2017, 14:30 (Dieser Beitrag wurde zuletzt bearbeitet: 02.04.2017, 14: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, 19:36 (Dieser Beitrag wurde zuletzt bearbeitet: 02.04.2017, 19: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, 20:32 (Dieser Beitrag wurde zuletzt bearbeitet: 02.04.2017, 20: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, 19:36 (Dieser Beitrag wurde zuletzt bearbeitet: 09.04.2017, 19: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
