Function myEvStr(Rng As Range) As String With CreateObject("vbscript.regexp") ".Pattern = "[^\d+\-*/().]+" .Pattern = "(【.*?】)*" .Global = True .MultiLine = False myEvStr = "=" & .Replace(Rng, "") End WithEnd FunctionSub 按鈕32_Click() Dim i, r r = Sheet3.Range("F65535").End(xlUp).Row For i = 5 To r Sheet3.Range(Cells(i, 7), Cells(i, 7)) = myEvStr(Range(Cells(i, 6), Cells(i, 6))) Next iEnd Sub複製程式碼
由於引數長度受限，用Evaluate構造自定義函式是不行了那就直接把計算公式的字串塞到單元格里吧
Function myEvStr(Rng As Range) As String With CreateObject("vbscript.regexp") ".Pattern = "[^\d+\-*/().]+" .Pattern = "(【.*?】)*" .Global = True .MultiLine = False myEvStr = "=" & .Replace(Rng, "") End WithEnd FunctionSub 按鈕32_Click() Dim i, r r = Sheet3.Range("F65535").End(xlUp).Row For i = 5 To r Sheet3.Range(Cells(i, 7), Cells(i, 7)) = myEvStr(Range(Cells(i, 6), Cells(i, 6))) Next iEnd Sub複製程式碼