从文本到数字的大文件崩溃

Question

下面的代码将文本转换为数字，但前缀0即002A的值除外。

这段代码可以在小数据文件上工作，但是在大文件上运行时会使Excel崩溃，即使我在代码运行之前关闭了计算。

vba

Sub Text2Number()
On Error GoTo EH
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set Rng = ActiveSheet.UsedRange
Rng.Cells(1, 1).Select
For i = 1 To Rng.Rows.Count
For j = 1 To Rng.Columns.Count
If Rng.Cells(i, j) <> "" Then
Union(Selection, Rng.Cells(i, j)).Select
End If
Next j
Next i
For Each c In Rng.Cells
If IsNumeric(c.Value) And Left$(c.Value, 1) <> "0" Then
c.NumberFormat = "General"
c.Value = c.Value
End If
Next
Rng.HorizontalAlignment = xlLeft
CleanUp:
On Error Resume Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Exit Sub
EH:
' Do error handling
Resume CleanUp
End Sub

Answer 1

使用下面的代码，您不必逐个转换数字，它肯定会挂起您的工作簿

一个更好的方法是使用一个虚拟的"text to column"在使用范围的每一列

我使用制表符作为分隔符，这通常不存在于excel文本中，如果它存在，您可以使用其他分隔符

Sub Text2Number_v2()
Application.Calculation = xlCalculationManual
last_col = ActiveSheet.UsedRange.Columns.Count
For col = 1 To last_col
Columns(col).TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Next
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 2

我是如何驯服这个宏并阻止它崩溃的

Sub Text2Number()
On Error GoTo EH
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Rng As Range
Set Rng = Application.Selection
Set Rng = Application.InputBox("Range", xTitleId, Rng.Address, Type:=8)
For Each c In Rng.Cells
If IsNumeric(c.Value) And Left$(c.Value, 1) <> "0" Then
c.NumberFormat = "General"
c.Value = c.Value
End If
Next
Rng.HorizontalAlignment = xlLeft
CleanUp:
On Error Resume Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Exit Sub
EH:
' Do error handling
Resume CleanUp
End Sub