Office: VBA Wert aus Tabelle suchen und gefundenen Wert schreiben

Hallo,

ich habe eine Makro, das in einem Selektierten Bereich (im Beispiel F4:F12) die Inhalte mit einer Tabelle abgleicht und den eigentlichen Wert durch den Wert aus der zweiten Spalte der Tabelle ersetzen soll. Funktioniert auch alles nur wenn die Werte in der Tabelle nicht gefunden werden, wird der Wert in dem Selektierten Bereich gelöscht bzw. mit "leer" überschrieben.
Ich möchte aber das das Makro den Fehler abfängt- wenn der selektierte Wert in der Tabelle nicht gefunden wird, soll der Selektierte Wert unberührt bleiben- also nicht überschreiben bzw gelöscht werden.
Wo im Makro unterbreche ich? Und wie?

Hier mein code und meine Tabelle:

Code:

Option Explicit
Sub KSTumwandeln()
Dim Zelle As Range
Dim strKST As String
For Each Zelle In Selection
    strKST = Zelle
    Zelle = Umwandeln(strKST, 2).Cells(2).Value
Next Zelle
End Sub


Public Function Umwandeln(strKST As String, Optional intAnz As Integer = 1) As Range
Dim rngSuch As Range, rngTabelle As Range
Set rngTabelle = Worksheets("Kst").Cells(1, 1).CurrentRegion
For Each rngSuch In rngTabelle.Rows
    With rngSuch
        If .Cells(1).Value = strKST Then
            Set Umwandeln = .Resize(1, intAnz)
            Exit Function
        End If
    End With
Next rngSuch
Set Umwandeln = rngTabelle.Resize(1, intAnz).Offset(rngTabelle.Rows.Count)
End Function

	A	B	C	D	E	F
1	97	243
2	1	2163
3	49	3417
4	19	2636				97
5	78	3116				1
6	41	3966				49
7	100	4747				19
8	59	3416				78
9	30	268				XXXXX
10	96	2109				59
11	6	3720				30
12	54	296				96
13	21	600
14	73	2186
15	11	3876
16	65	3337
17	37	3187
18	2	58

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Ich benutze Excel 2010
Danke

 

Hi Marius,

ich würde es so lösen:

Code:

Sub KSTumwandeln()
   Dim Zelle As Range
   Dim rngSuche As Range
   For Each Zelle In Selection
       Set rngSuche = Columns(1).Find(Zelle.Value, lookat:=xlWhole)
       If Not rngSuche Is Nothing Then Zelle.Value = rngSuche.Offset(0, 1)
   Next Zelle
   Set rngSuche = Nothing
End Sub

Bis später,
Karin

 

Ok. so gehts natrülich auch:)
Hab wohl etwas zu kompliziert gedacht.

Danke!