excel - 将大型数据集中的字符串转换为数字

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

试试这个。这使用数组来完成整个操作。与遍历每个范围相比，这非常快。

逻辑:

1. 循环遍历工作表并找到最后一行和最后一列
2. 确定范围，而不是盲目使用UsedRange。您可能想查看THIS
3. 将该数据复制到数组中
4. 清除工作表 - 将工作表的格式重置为常规。希望工作表中没有其他格式吗？如果您已经看到了第二段代码。
5. 将数据粘贴回工作表。

代码

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

屏幕截图