将 1000 万行带字母的文本转换为数字

Question

我需要将“文本数字”转换为数字。文本编号如下所示：32,23B 或 242,23M。

我需要删除字母并乘以 1,000 ； 1,000,000；等等，取决于字母。
下面的代码有效，但因为我需要转换 1000 万行，所以需要很长时间。

有什么巧妙的方法吗？

For shIndex = startSheet To lastSheet
    LastRowF = Sheets(shIndex).Range("F" & Rows.Count).End(xlUp).Row
        
    For i = 3 To LastRowF
        
        Mul = Right(Sheets(shIndex).Range("F" & i), 1)
            
        Select Case Mul
            Case "K"
                Multiplier = 1
            Case "M"
                Multiplier = 1000
            Case "B"
                Multiplier = 1000000
            Case "T"
                Multiplier = 1000000000
            Case Else
                Multiplier = False
        End Select
            
        If Multiplier Then
            With Sheets(shIndex)
                .Range("F" & i) = CSng(Left(Sheets(shIndex).Range("F" & i), Len(Sheets(shIndex).Range("F" & i)) - 1) * Multiplier)
                .Range("F" & i).NumberFormat = "#,##0"
            End With
        End If
    Next i
Next shIndex

Answer 1

使用Variant数组，在内存中进行转换，然后将整个数组写回sheet:

For shIndex = startSheet To lastSheet
    LastRowF = Sheets(shIndex).Range("F" & Rows.Count).End(xlUp).Row

    Dim data() As Variant
    data = Sheets(shIndex).Range("F3:F" & LastRowF).Value

    Dim i As Long
    For i = LBound(data, 1) to UBound(data, 1)
        Mul = Right(data(i, 1), 1)

        Select Case Mul
            Case "K"
                Multiplier = 1
            Case "M"
                Multiplier = 1000
            Case "B"
                Multiplier = 1000000
            Case "T"
                Multiplier = 1000000000
            Case Else
                Multiplier = False
        End Select

        If CBool(Multiplier) Then
            data(i, 1) = Left(data(i,1), Len(data(i, 1)) - 1) * Multiplier
        End 

        With Sheets(shIndex).Range("F3:F" & LastRowF)
           .Value = data
           .NumberFormat = "#,##0"
        End With 
     
    Next
Next

Answer 2

修改号码格式

实现数组可能会成功。

代码

Option Explicit

Sub modifyValues()
    
    Const FirstCell As String = "F3"
    Const startSheet As Long = 1
    Const lastSheet As Long = 1
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim Data As Variant
    Dim Current As Variant
    Dim Multiplier As Variant
    Dim Mul As String
    Dim shIndex As Long
    Dim LastRow As Long
    Dim i As Long
    
    For shIndex = startSheet To lastSheet
        With wb.Worksheets(shIndex).Range(FirstCell)
            LastRow = .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row
            Set rng = .Resize(LastRow - .Row + 1)
        End With
        Data = rng.Value
        For i = 1 To UBound(Data, 1)
            Current = Data(i, 1)
            Mul = Right(Current, 1)
            Select Case Mul
                Case "K"
                    Multiplier = 1
                Case "M"
                    Multiplier = 1000
                Case "B"
                    Multiplier = 1000000
                Case "T"
                    Multiplier = 1000000000
                Case Else
                    Multiplier = False
            End Select
            If Multiplier Then
                Data(i, 1) = CSng(Left(Current, Len(Current) - 1) * Multiplier)
            End If
        Next i
        rng.Value = Data
        rng.NumberFormat = "#,##0"
    Next shIndex

End Sub

将 1000 万行带字母的文本转换为数字

Convert 10M rows of Text with letters To Number

excel

vba

data-conversion

修改号码格式