vba 从一系列单元格中删除非数字字符
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/10789948/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Remove non-numeric characters from a range of cells
提问by bobzrz8
- I have a 1500 row excel file.
- In the first column I have characters mixed up with numbers (every row is different).
- I would like to leave only the numbers and delete the alpha characters.
- 我有一个 1500 行的 excel 文件。
- 在第一列中,我将字符与数字混合在一起(每一行都不同)。
- 我只想留下数字并删除字母字符。
For example in A1
I have
例如在A1
我有
f90f5j49,35.48
f90f5j49,35.48
and after I delete the alpha characters it should be
在我删除字母字符后,它应该是
905493548
905493548
What is the best way to do this?
做这个的最好方式是什么?
I did find this youtube solution
我确实找到了这个youtube 解决方案
Thanks!
谢谢!
回答by brettdj
Your method is the right approach.
你的方法是正确的方法。
The quickest way to implement this is to use
实现这一点的最快方法是使用
- a regexp
- and a variant array in VBA.
- 一个正则表达式
- 和 VBA 中的变体数组。
Using code based on my Article Using Variant Arrays in Excel VBA for Large Scale Data Manipulation
使用基于我的文章Using Variant Arrays in Excel VBA for Large Scale Data Manipulation 的代码
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 = Application.InputBox("Select range for the replacement of non-number", "User select", Selection.Address, , , , , 8)
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