VBA 将文本转换为数字，公式和非数字文本除外

VBA to convert texts to numbers except formula and non-numeric texts

提问by yinka

I have a Range("B6:T10000")

我有一个 Range("B6:T10000")

Data in the range are a mixture of blanks,#'s,numbers (formatted as texts), textsand most importantly formulas.

在范围内的数据是的混合物blanks，#'s，numbers (formatted as texts)，texts和最重要的formulas。

Can someone please help with a VBA macro to:

有人可以帮助使用 VBA 宏来：

• Find anything that looks like number and convert it to number
• Ignore the rest
• Don't convert formulas to values

• 找到任何看起来像数字的东西并将其转换为数字
• 忽略其余
• 不要将公式转换为值

Thank you very much

非常感谢

采纳答案by Gary's Student

Give this a try:

试试这个：

Sub Converter()
    Dim rBig As Range, r As Range, v As Variant
    Set rBig = Range("B6:T10000")
    For Each r In rBig
        v = r.Value
        If v <> "" And r.HasFormula = False Then
            If IsNumeric(v) Then
                r.Clear
                r.Value = v
            End If
        End If
    Next r
End Sub

EDIT#1:

编辑#1：

This version ignores errors:

此版本忽略错误：

Sub Converter()
    Dim rBig As Range, r As Range, v As Variant
    Set rBig = Range("B6:T10000")
    For Each r In rBig
        v = r.Value
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                End If
            End If
        End If
    Next r
End Sub

回答by brettdj

You can do this without code, or with quicker code avoiding loops

您可以在没有代码的情况下执行此操作，或者使用更快的代码避免循环

Manual

手动的

1. Copy a blank cell
2. Select your range B6:T100001
3. Press F5. Then Goto ... Special
4. check Constantsand then Text
5. Paste Special Multiplyand check Add

1. 复制一个空白单元格
2. 选择您的范围 B6:T100001
3. 按F5。然后Goto ... Special
4. 检查Constants然后Text
5. Paste Special Multiply并检查 Add

This converts text only cells with numbers into numbers, and leaves actual text or formulae alone

这会将带有数字的纯文本单元格转换为数字，并保留实际的文本或公式

Code

代码

Sub Update()
Dim rng1 As Range
On Error Resume Next
Set rng1 = Range("B6:T10000").SpecialCells(xlCellTypeConstants, 2)
On Error Resume Next
If rng1 Is Nothing Then Exit Sub
'presumes last cell in sheet is blank
Cells(Rows.Count, Columns.Count).Copy
rng1.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
End Sub

回答by L42

here's my version:

这是我的版本：

Sub Test()

Dim rng as Range, cel as Range

Set rng = Thisworkbook.Sheets("Sheet1").Range("B6:T10000")

For Each cel In rng
    If Not IsError(cel.Value) Then _
        If Len(cel.Value) <> 0 And cel.HasFormula = False And _
            IsNumeric(cel.Value) Then cel.Value = Val(cel.Value)
Next cel

End Sub

I've tested it, and works fine.
Hope this helps.

我已经测试过了，效果很好。
希望这可以帮助。

回答by ghasem76

ActiveSheet.Range("b5:b6004,h5:h6004").Select    
For Each xCell In Selection    
If IsNumeric(xCell) = False Then    
    xCell.Value = Val(xCell.Value)    
Else    
End If    
Next xCell