Eingabezelle Zahl automatisch ersetzen VBA ?

Hallo zusammen
ich habe eine Tabelle in der in Spalte E - Teilenummern eingegeben werden.
Jetzt soll in dieser Spalte überprüft werden ob es eine Teilenummerersetzung gibt.
Sprich: in Spalte E10 wird zb. die Zahl 5023844 eingegeben.
Dann soll sobald mit Enter oder Tab bestätigt wird diese Zahl in die neue ersetzte Zahl umspringen.
Die Ersetzungskette für 5023844 ist: 5023844 > 1047035 > 1209799 > 1222116 > 1336797 > 1931955
In diesem Fall sollte 1931955 angezeigt werden.
Ich hab es mit der Auto Korrektur versucht. Allerdings wird dann immer nur in die nächste Zahl ersetzt und nicht in das Ende der Ersetzungskette.
Geht so was vielleicht über VBA, und einem Verweis in eine andere Ersetzungstabelle ?
Vielen Dank
und Gruß
Erik

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
folgender Aufbau wurde angenommen:

Tabelle2

	A	B	C	D	E	F	G	H
1	Ursprung	1	2	3	4	5	6
2	5023844	5023844	1047035	1209799	1222116	1336797	1931955
3	4711	4712
4	815	816	817
5

Tabelle1

	A	B	C	D	E	F
1					Überschrift
2					4712
3					4712
4					817
5
6

http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip

http://Hajo-Excel.de/tools.htm

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 21.10 einschl. 64 Bit

das ginge so...
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Diesen Code dort reinkopieren

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    Dim TB, LC As Integer, Z, Zeile As Double
    
    Set TB = Sheets("Tabelle2")
    
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        If Target.Row <= 1 Then Exit Sub 'wegen Überschrift 
        For Each Z In Target
            If Z <> "" Then
                With TB
                    If WorksheetFunction.CountIf(.Columns(1), Z) > 0 Then
                        Zeile = WorksheetFunction.Match(Z, .Columns(1), 0)
                        LC = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 
                        
                        Application.EnableEvents = False
                        Z.Value = .Cells(Zeile, LC)
                        MsgBox "Folgenummer wurde eingesetzt"
                        Application.EnableEvents = True
                    End If
                End With
            End If
        Next
    End If
    
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Gruß UweD
Über Rückmeldungen würde ich mich freuen

Private Sub Worksheet_Change(ByVal Target As Range) Dim newNumber As String: newNumber = "1931955" Select Case Target.Text Case "5023844": Target.Value = newNumber Case "1047035": Target.Value = newNumber Case "1209799": Target.Value = newNumber Case "1222116": Target.Value = newNumber Case "1336797": Target.Value = newNumber End Select End Sub

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Dim TB, LC As Integer, C As Range, Z Set TB = Sheets("Tabelle2") If Not Intersect(Range("E:E"), Target) Is Nothing Then If Target.Row <= 1 Then Exit Sub 'wegen Überschrift For Each Z In Target If Z <> "" Then With TB Set C = .UsedRange.Find(Z, LookIn:=xlValues) If Not C Is Nothing Then LC = .Cells(C.Row, .Columns.Count).End(xlToLeft).Column If C.Column < LC Then Application.EnableEvents = False Z.Value = .Cells(C.Row, LC) MsgBox "Folgenummer wurde eingesetzt" Application.EnableEvents = True End If End If End With End If Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

Eingabezelle Zahl automatisch ersetzen VBA ?

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Eingabezelle Zahl automatisch ersetzen VBA ?

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread