Ausführen verschiedener Funktionen auf Eingabe und dann Ausgabe an Zelle

Question

Ich habe derzeit ein Makro, das eine Eingabe aus einer Zelle in einer Spalte nimmt, entfernt Text und Leerzeichen, verkürzt auf die letzten 13 Ziffern und gibt dann in nächste Spalte über.

Ich wurde ein wenig Code in einer vorherigen Frage angezeigt, die Regex verwendet, um den Text zu entfernen (ich hatte zuvor die Leerzeichen entfernt werden, ok). Ich bin mir jedoch nicht sicher, wie ich die Funktion ausführen und mit meinem aktuellen Code an die Zelle ausgeben kann.

Momentan ist alles, was es tut, auf 13 Stellen zu kürzen, also denke ich, dass die Funktion nicht korrekt ausgeführt/aufgerufen wird.

Aktuelle Makro ist:

Sub RemoveSpaces_Click() 

i = 7 
j = 7 

Do While ActiveWorkbook.ActiveSheet.Cells(i, 1) <> "" 

    InputString = ActiveWorkbook.ActiveSheet.Cells(i, 1) 

    removeAlpha (InputString) ' <--- How to call this? 

    ' Right() after removing to avoid text counting as length 

    InputString = Right(InputString, 13) 

    j = j + 1 

    ' Output to second column to preserve original input 

    ActiveWorkbook.ActiveSheet.Cells(i, 2) = InputString 

    i = i + 1 

    Loop 

End Sub 

Function removeAlpha(strInput As String) As String 

    strInput = Replace(strInput, " ", "") 

    With CreateObject("vbscript.regexp") 
     .Pattern = "[A-Za-z]" 
     .Global = True 
     removeAlpha = .Replace(strInput, "") 
    End With 

End Function 

Answer 1

Es wird automatisch ausgeführt, solange Sie etwas in A7 haben, wird es den Text in A7 verwenden und es durch Ihre Funktion ausführen. Die Funktion verwendet die Daten von InputString.

Option Explicit 

Sub RemoveSpaces_Click() 
Dim i As Long, j As Long 
Dim InputString As String 
Dim OutputString As String 
Dim ResultString As String 

i = 7 
j = 7 

' If A7 is not empty continue and continue the loop until cell in column A is empty 
Do While ActiveWorkbook.ActiveSheet.Cells(i, 1) <> "" 

    ' This string will contain data from A7 
    InputString = ActiveWorkbook.ActiveSheet.Cells(i, 1) 

    ' This will use the InputString value in the function and save it to OutputString 
    OutputString = removeAlpha(InputString) ' This will be called automatically 

    ' Right() after removing to avoid text counting as length 
    ' Use the OutputString in the Right-function and save to ResultString 
    ResultString = Right(OutputString, 13) 

    ' Loop incremental 
    j = j + 1 

    ' Output to second column to preserve original input 
    ActiveWorkbook.ActiveSheet.Cells(i, 2) = ResultString 

    ' Loop incremental for your rows (7, 8 etc.) 
    i = i + 1 

    Loop 
End Sub