|
Hallo zusammen,
hatte das Thema bereits eröffent, aber die Aufgabenstellung unklar formuliert. Der vorherige Thread kann gerne geschlossen werden. :)
Es exisitiert eine Datei mit mehreren Tabellen ("Blättern" = Tabelle 1, Tabelle 2, usw.). Innerhalb dieser Tabellen taucht die Spalte "Customer_ID" mehrmals auf. Insgesamt handelt es sich um über 1.000 Customer ID's, welche in einer Spalte auch mehrmals auftreten können.
Zunächst soll jede einzelne Customer_ID fortlaufend (bzw. automatisch / nicht händisch) mit einer neuen, festen Bezeichnung überschrieben werden (Abbildung 1). Am besten in einem ABC+Zahl-Format (Zahl aufteigend ab 1), wie in der Abbildung 1. Z.B.:
Customer_ID = 1 -> ABC1
Customer_ID = 2 -> ABC2
Customer_ID = 1000 -> ABC1000
Nun soll in jeder Tabelle, in der z.B. die Customer_ID = 1 auftaucht, auch mit der zuvor neu zugewiesenen Bezeichnung überschrieben werden, ohne explizit jede einzelne ID anzusprechen (anders als im unten angegeben Code).
Die Customer_ID, kann wie bereits beschrieben auch mehrmals in einer Tabelle und auf mehreren "Blättern" vorhanden sein (Abbildung 2&3). Z.B.:
Tabelle 1(Blatt 1) & Tabelle 2 (Blatt 2) usw.
Customer_ID = 1 -> ABC1
Customer_ID = 1 -> ABC1
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Bisheriger Code:
Option Explicit
Sub Test()
Dim rngData As Excel.Range
Dim rngMatch As Excel.Range
Dim vntWhat As Variant
Dim vntReplace As Variant
With Worksheets("Tabelle1")
With Worksheets("Tabelle2")
Set rngData = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With
End With
vntWhat = 1
vntReplace = "ABC1"
Set rngMatch = rngData.Find(vntWhat, , xlValues, xlWhole, xlByColumns, xlNext, False)
If rngMatch Is Nothing Then
Call MsgBox("Nichts gefunden.")
Exit Sub
End If
Do
rngMatch.Value = vntReplace
Set rngMatch = rngData.FindNext(rngMatch)
Loop Until rngMatch Is Nothing
Call MsgBox("Done.", vbInformation)
End Sub
|