Question

我目前正在使用此代码将包含十进制数字的大量单元格转换为十进制数字：

For Each ws In Sheets
    On Error Resume Next
    For Each r In ws.UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(r) Then r.Value = CDbl(r.Value)
    Next
Next

此操作运行速度非常慢，我希望它尽可能快地运行。

我是初学者，上面显示的代码是通过谷歌收集的。是否可以通过编辑代码或使用不同的代码来加快此操作的速度？

Answer 1

试试这个。这使用Array来执行整个操作。与循环每个范围相比，这非常快。

<强>逻辑：

遍历工作表并找到最后一行和最后一列
识别范围，而不是盲目地使用UsedRange。您可能希望查看THIS
将该数据复制到数组
清除工作表 - 将工作表的格式重置为General。希望表单中没有其他格式？如果您已经看到第二段代码。
将数据粘贴回工作表。

<强>代码

Sub Sample()
    Dim ws As Worksheet
    Dim usdRng As Range
    Dim lastrow As Long, lastcol As Long
    Dim myAr

    For Each ws In Sheets
        With ws
            '~~> Check if sheet has any data
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                '~~> Find Last Row
                lastrow = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row

                '~~> Find last column
                lastcol = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column

                '~~> Set your range here
                Set usdRng = .Range("A1:" & _
                Split(.Cells(, lastcol).Address, "$")(1) & lastrow)

                '~~> Write to array
                myAr = usdRng.Value

                '~~> Clear the sheet
                .Cells.Clear

                '~~> Write back to the sheet
                .Range("A1").Resize(lastrow, lastcol).Value = myAr
            End If
        End With
    Next
End Sub

<强>截图

修改

如果表格中有其他格式，请使用此

Sub Sample() Dim ws As Worksheet Dim usdRng As Range, rng as Range Dim lastrow As Long, lastcol As Long Dim myAr For Each ws In Sheets With ws '~~> Check if sheet has any data If Application.WorksheetFunction.CountA(.Cells) <> 0 Then '~~> Find Last Row lastrow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row '~~> Find last column lastcol = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column '~~> Set your range here Set usdRng = .Range("A1:" & _ Split(.Cells(, lastcol).Address, "$")(1) & lastrow) On Error Resume Next Set rng = usdRng.SpecialCells(xlCellTypeConstants) On Error GoTo 0 If Not rng Is Nothing Then '~~> Write to array myAr = usdRng.Value '~~> Clear the Range rng.NumberFormat = "0.00" Set rng = Nothing '~~> Clear contents of the sheet usdRng.ClearContents '~~> Write back to the sheet .Range("A1").Resize(lastrow, lastcol).Value = myAr End If End If End With Next End Sub

<强>截图

Answer 2

根据您的内容，您可以使用

快速保存一些处理

For Each r In ws.UsedRange.SpecialCells(xlCellTypeConstants,xlTextValues)

或者，将范围（或部分，如果非常大）移动到数组中（使用myArray=range("b2:x200")），然后处理数组并立即重写它。这要快得多，因为在您的样本中，慢速部分实际上是VBA与细胞之间的相互作用。

Sub test()
    Dim src As Range
    Dim ar As Variant
    Dim r As Long, c As Long

    Set src = Range("b2").CurrentRegion
    ar = src    'move ange into array
    For r = 1 To UBound(ar, 1)
        For c = 1 To UBound(ar, 2)
            If VarType(ar(r, c)) = 8 Then 'string
                If IsNumeric(ar(r, c)) Then
                    ar(r, c) = CDbl(ar(r, c))
                End If
            End If
        Next c
    Next r
    src = ar    'write array back to sheet
End Sub

Answer 3

另外两个选项，没有VBA：

启用错误检查是否关闭，选择适当的范围，单击!，单击转换为数字。
在单元格中输入1，然后选择并复制它。选择适当的范围，选择Paste Special ...，Operation multiply。（将空白单元格转换为0。）

Answer 4

关闭和关闭用户界面。

'turn off UI
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlManual

--- your code here

'turn on UI
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic

Answer 5

我的版本 - 使用您的首选选项设置范围 - 我刚刚使用了UsedRange，但最好使用FIND（Siddharths代码使用此选项）。

我将数字1放入一个空白单元格（我已经使用了工作表中的最后一个单元格），复制该数字并粘贴特殊和乘法 - 任何数字将乘以1并返回一个数字，任何文本都保留为

Sub TurnToNumbers()

    Dim rng As Range

    With Worksheets("Sheet1")
        Set rng = .UsedRange.SpecialCells(xlCellTypeConstants)

        'Place 1 into an empty cell, copy it and pastespecial and multiply.
        .Cells(Rows.Count, 1) = 1
        .Cells(Rows.Count, 1).Copy
        rng.PasteSpecial Operation:=xlPasteSpecialOperationMultiply
        .Cells(Rows.Count, 1).ClearContents
    End With

End Sub

在大型数据集中将字符串转换为数字

5 个答案: