Hallo Mehoranto
probier das mal bitte.
Die Originalen Daten werden überschrieben.
Probleme würden Eintragen wie "12km mehr als 7" machen. 
 

Vielleicht hilft das ja weiter

Gruß

Sub KM_ändern()
    Dim WS As Worksheet
    Set WS = ActiveSheet
    
    Dim Zeichen As String
    Dim zMax As Long
    Dim Pos As Long
    Dim Idx As Long
    Dim TXT As String
   
    Dim Daten As Variant
    
    Zeichen = "0123456789,"
    
    'letzte Zeile in der Spalte 'A' (1) suchen
    zMax = WS.Cells(2 ^ 16, 1).End(xlUp).Row
    'Von Zeile 2 bis zur letzten Zeile die Spalte 'A' (1) in das Array 'Daten' schreiben
    Daten = WS.Range(WS.Cells(2, 1), WS.Cells(zMax, 1))
    
    'Das Array 'Daten' vom ersten zum letzten Feld durchlaufen
    For Idx = LBound(Daten, 1) To UBound(Daten, 1)
        'Wenn keine Zahl drinsteht dann ...
        If IsNumeric(Daten(Idx, 1)) = False Then
            TXT = ""
            'Durchlaufe gesamten Zellinhalt Zeichen für Zeichen
            For Pos = 1 To Len(Daten(Idx, 1))
                'Überprüfe jedes Zeichen mit erlaubten Zahlenzeichen (mit Komma)
                If InStr(1, Zeichen, Mid(Daten(Idx, 1), Pos, 1), vbTextCompare) > 0 Then
                    'Erstelle eine Zeichenkette mit den gefundenen Zahlen 
                    TXT = TXT & Mid(Daten(Idx, 1), Pos, 1)
                End If
            Next Pos
            'Geänderte Zahl wieder in Array schreiben
            'Ich addiere nur 0,1 und Runde die Zahl auf. Bei 5,7 ergibt das dann 6 und bei ganzen Zahlen eins mehr
            Daten(Idx, 1) = Application.WorksheetFunction.RoundUp(CSng(TXT) + 0.1, 0)
        End If
    Next Idx
    'Debug in Spalte 'B' (Hier die 2)
'    WS.Range(WS.Cells(2, 2), WS.Cells(zMax, 2)) = Daten
    'Originale Daten überschreiben
    WS.Range(WS.Cells(2, 1), WS.Cells(zMax, 1)) = Daten
    
    Set WS = Nothing
End Sub