nach zweimaliger gloreicher Hilfe aus dem Forum (an dieser Stelle nochmals vielen Dank!), möchte ich das nächste Problem, welches ich nicht gelöst bekomme hier einstellen in der Hoffnung das die kommenden Antworten vielen anderen auch helfen.
Ich möchte gerne via Inputbox (falls andere Möglichkeiten gibt bin ich dafür offen, eventuell über userform) einen Wert suchen und ersetzten, sowie die Zelle 3 Spalten weiter der gleichen Zeile mit einem anderen Wert ersetzten.
Beispiel:
In Zeile 3,9 und 89 steht in Spalte C der Wert "12345" und in Spalte F der Wert "3".
Diese sollen nun ersetzt werden.
Beim Starten des Makros soll eine Inputbox erscheinen in welche der Benutzer zuerst den zu suchenden Wert einträgt, in einer zweiten und dritten Inputbox sollen dann die Werte stehen die als Ersatz vorgesehen sind.
So soll in Zeile 3,9 und 89 in Spalte C dann 67890 stehen und in Spalte F "15".
Das Makro soll alle entsprechenden Werte der Spalte C in allen Tabellenblätter suchen ersetzten.
Versucht habe ich folgendes aber das klappt vorne und hinten nicht:
Sub Artikelnummer_und_Umrechnungsfaktor_ersetzen()
Dim Alt As Integer
Dim Neu As Integer
Dim Neu2 As Integer
Dim rngZelle As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
'Inputbox mit Dialogfeld erstellen für alte Artikelnummer
Alt = InputBox("Bitte alte Artikelnummer eingeben", "Ersetzten von Artikelnummer inkluse _
Umrechnungsfaktoren", "Alte Art. Nr.")
'Prüfen ob Eintrag vorliegt
If Alt = "" Then Exit Sub
'Inputbox und Prüfung für neue Artikelummer
Neu = InputBox("Bitte neue Artikelnummer eingeben", "Ersetzten von Artikelnummer inkluse _
Umrechnungsfaktoren", "Neue Art. Nr.")
If Neu = "" Then Exit Sub
'Inputbox und Prüfung für neuen Umrechnungsfaktor
Neu = InputBox("Bitte den neuen Umrechnungsfaktor eingeben", "Ersetzten von Artikelnummer _
inkluse Umrechnungsfaktoren", "Neuer Umrechnungsfaktor")
If Neu = "" Then Exit Sub
' Schleife die alle Zellen Spalte C durchsucht -> Austausch Neu gegen Alt, sowie Ersetzen von _
_
Spalte F durch Neu2
For Each ws In Worksheets
For Each rngZelle In ws.Range(C)
If InStr(1, rngZelle.Value, Alt) Then
rngZelle.Value = Replace(rngZelle.Value, Alt, Neu)
ActiveCell.Offset(0, 3).Select
ActiveCell = Neu2
End If
Next
Next
End Sub
Als i-Tüpfelchen wäre noch eine MsgBox toll die sagt wenn kein Zahlenwert oder kein Wert Wert eingeben wurde, das dies gemacht werden muss (Inputbox geht wieder auf - quasi erzwungene Wiederholung).
Schönen gruß und vielen Dank im Voraus
Thomas