VBA编辑Excel数据列

我有一个要求编辑一个数据列，其中每个单元格必须进行编辑，以删除所有非数字字符。 我需要的唯一数据是实际的数字和一个小数点，如果原来有一个。 我发现了一段除了“％”字符之外的所有代码。 如果有人可以看下面的代码，让我知道如何修改它，我会感激。 我正在编辑的数据types的示例如下所示：完整的单元格内容用引号括起来）。 “3”“2.5％”“17 nks”“3.00％”“4 VNS”

这是我用过的代码

Sub RemoveAlphas() '' Remove alpha characters from a string. Dim intI As Integer Dim rngR As Range, rngRR As Range Dim strNotNum As String, strTemp As String Set rngRR = Selection.SpecialCells(xlCellTypeConstants, _ xlTextValues) For Each rngR In rngRR strTemp = "" For intI = 1 To Len(rngR.Value) If Mid(rngR.Value, intI, 1) Like "[0-9,.]" Then strNotNum = Mid(rngR.Value, intI, 1) Else: strNotNum = "" End If strTemp = strTemp & strNotNum Next intI rngR.Value = strTemp Next rngR End Sub 

谢谢。

Answer 1

这可以使用正则expression式来完成，如下所示 – 已经用您的确切样本数据进行了testing，并为我工作：

 Sub RemoveAlphas() '' Remove alpha characters from a string. Dim intI As Integer Dim rngR As Range, rngRR As Range Dim strNotNum As String, strTemp As String Dim RegEx As Object Set rngRR = Selection.SpecialCells(xlCellTypeConstants, _ xlTextValues) Set RegEx = CreateObject("VBScript.RegExp") RegEx.Global = True RegEx.Pattern = "[^\d.]+" For Each rngR In rngRR rngR.Value = RegEx.Replace(rngR.Value, "") Next rngR End Sub 

Answer 2

如果你正在得到你需要的结果，除了百分号，你可以在你的代码中插入一个replace函数：

  Next intI strTemp = Replace(strTemp, "%", "") 'Remove the % sign and replace with nothing. rngR.Value = strTemp Next rngR 

Answer 3

尝试下面的RexExp，它build立在我的代码上， 从一系列单元格中移除非数字字符 ，并使用变体数组来提高速度。

RegExp模式是[^\d\.]+

 Sub KillNonNumbers() Dim rng1 As Range Dim rngArea As Range Dim lngRow As Long Dim lngCol As Long Dim lngCalc As Long Dim objReg As Object Dim X() On Error Resume Next Set rng1 = Selection.SpecialCells(xlCellTypeConstants, xlTextValues) If rng1 Is Nothing Then Exit Sub On Error GoTo 0 'See Patrick Matthews excellent article on using Regular Expressions with VBA Set objReg = CreateObject("vbscript.regexp") objReg.Pattern = "[^\d\.]+" objReg.Global = True 'Speed up the code by turning off screenupdating and setting calculation to manual 'Disable any code events that may occur when writing to cells With Application lngCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With 'Test each area in the user selected range 'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on For Each rngArea In rng1.Areas 'The most common outcome is used for the True outcome to optimise code speed If rngArea.Cells.Count > 1 Then 'If there is more than once cell then set the variant array to the dimensions of the range area 'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks X = rngArea.Value2 For lngRow = 1 To rngArea.Rows.Count For lngCol = 1 To rngArea.Columns.Count 'replace the leading zeroes X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString) Next lngCol Next lngRow 'Dump the updated array sans leading zeroes back over the initial range rngArea.Value2 = X Else 'caters for a single cell range area. No variant array required rngArea.Value = objReg.Replace(rngArea.Value, vbNullString) End If Next rngArea 'cleanup the Application settings With Application .ScreenUpdating = True .Calculation = lngCalc .EnableEvents = True End With Set objReg = Nothing End Sub