Chuyển code tách số từ chuổi sang số

[blueforever]

Em có đoạn code chuyển từ chuổi sang số, nhưng phải chạy thủ công bằng cách Alt+F8, xin hỏi anh chị để save thành file dạng macro .xla thì phải chỉnh sửa gì k ạ?

Private Function SuperTrim(TheStr As String)
  Dim Temp As String, DoubleSpase As String
  DoubleSpase = Chr(32) & Chr(32)
  Temp = Trim(TheStr)
  Temp = Replace(Temp, DoubleSpase, Chr(32))
  Do Until InStr(Temp, DoubleSpase) = 0
    Temp = Replace(Temp, DoubleSpase, Chr(32))
  Loop
  SuperTrim = Temp
End Function '
Public Sub Tach_So()
  Dim strText As String, strText_1 As String
  Dim subText() As String, so() As Double
  Dim i As Integer, j As Integer, k As Integer, m As Integer
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  strText = ActiveCell.Text
  strText = SuperTrim(strText)
  subText = Split(strText, " ")
  For i = 0 To UBound(subText)
    For j = 1 To Len(subText(i))
      k = 0
      If IsNumeric(Mid(subText(i), j, 1)) Then
        k = j
        Exit For
      End If
    Next j
    If k <> 0 Then
      m = m + 1
      strText_1 = Val(Mid(subText(i), k))
      Cells(ActiveCell.Row, ActiveCell.Column + m) = strText_1
    End If
  Next i
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub