用Excel VBA从数字中分离string

我需要

a）从数字中为单元格select分隔string

和

b）将分离的string和数字放在不同的列中。

例如，Excel工作表如下所示：

A1 B1 100CASH etc.etc. 

结果应该是：

  A1 B1 C1 100 CASH etc.etc. 

使用正则expression式将是有用的，因为可能有不同的单元格格式，例如100-CASH，100 / CASH，100％CASH。 一旦build立了这个程序，对于不同的变化就不会很难使用正则expression式。

我遇到了一个UDF从一个单元格中提取数字。 这可以很容易地修改，从单元格中提取string或其他types的数据，只需更改正则expression式即可。

但是我需要的不仅仅是一个UDF，而是一个使用正则expression式拆分单元格的子程序，并将分离的数据放在单独的列中。

我也在SU中发现了一个类似的问题，但它不是VBA。

Answer 1

看看这是否会为你工作：

11/30更新：

 Sub test() Dim RegEx As Object Dim strTest As String Dim ThisCell As Range Dim Matches As Object Dim strNumber As String Dim strText As String Dim i As Integer Dim CurrCol As Integer Set RegEx = CreateObject("VBScript.RegExp") ' may need to be tweaked RegEx.Pattern = "-?\d+" ' Get the current column CurrCol = ActiveCell.Column Dim lngLastRow As Long lngLastRow = Cells(1, CurrCol).End(xlDown).Row ' add a new column & shift column 2 to the right Columns(CurrCol + 1).Insert Shift:=xlToRight For i = 1 To lngLastRow ' change to number of rows to search Set ThisCell = ActiveSheet.Cells(i, CurrCol) strTest = ThisCell.Value If RegEx.test(strTest) Then Set Matches = RegEx.Execute(strTest) strNumber = CStr(Matches(0)) strText = Mid(strTest, Len(strNumber) + 1) ' replace original cell with number only portion ThisCell.Value = strNumber ' replace cell to the right with string portion ThisCell.Offset(0, 1).Value = strText End If Next Set RegEx = Nothing End Sub 

Answer 2

怎么样：

 Sub UpdateCells() Dim rng As Range Dim c As Range Dim l As Long Dim s As String, a As String, b As String ''Working with sheet1 and column C With Sheet1 l = .Range("C" & .Rows.Count).End(xlUp).Row Set rng = .Range("C1:C" & l) End With ''Working with selected range from above For Each c In rng.Cells If c <> vbNullString Then s = FirstNonNumeric(c.Value) ''Split the string into numeric and non-numeric, based ''on the position of first non-numeric, obtained above. a = Mid(c.Value, 1, InStr(c.Value, s) - 1) b = Mid(c.Value, InStr(c.Value, s)) ''Put the two values on the sheet in positions one and two ''columns further along than the test column. The offset ''can be any suitable value. c.Offset(0, 1) = a c.Offset(0, 2) = b End If Next End Sub Function FirstNonNumeric(txt As String) As String With CreateObject("VBScript.RegExp") .Pattern = "[^0-9]" FirstNonNumeric = .Execute(txt)(0) End With End Function