代码之家  ›  专栏  ›  技术社区  ›  Vinnie Novido

字符串转换不符

  •  0
  • Vinnie Novido  · 技术社区  · 6 年前

    https://www.thespreadsheetguru.com/the-code-vault/2014/8/21/convert-numbers-stored-as-text

    它运行得又快又平稳,这是非常值得赞赏的,但当我开始处理数据时,我注意到一个不一致的地方。我发现两个细胞转化成了两个完全不同的数字。在写这篇文章时,我只找到了这两个,但如果还有更多的话,那就相当令人担忧了。例如字符串“1225”变成了-611779(是的,我使用的是十进制逗号)

    我现在的问题是:这两个(或者更多的单元格)是否有可能导致脚本在正确转换这些数字时完全失败。还是代码有缺陷?

    Sub CleanData(sRange As Range)
    
    'PURPOSE:Clean up selected data by trimming spaces, converting dates,
    'and converting numbers to appropriate formats from text format
    'AUTHOR: Ejaz Ahmed (www.StrugglingToExcel.Wordpress.com)
    'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
    
    Dim MessageAnswer As VbMsgBoxResult
    Dim EachRange As Range
    Dim TempArray As Variant
    Dim rw As Long
    Dim col As Long
    Dim ChangeCase As Boolean
    Dim ChangeCaseOption As VbStrConv
    Dim rng As Range
    
    'User Preferences
      ChangeCaseOption = vbProperCase
      ChangeCase = False
    
    'Set rng = Application.Selection
    Set rng = sRange
    
    'Warn user if Range has Formulas
      If RangeHasFormulas(rng) Then
        MessageAnswer = MsgBox("Some of the cells contain formulas. " _
          & "Would you like to proceed and overwrite formulas with values?", _
          vbQuestion + vbYesNo, "Formulas Found")
        If MessageAnswer = vbNo Then Exit Sub
      End If
    
    'Loop through each separate area the selected range may have
      For Each EachRange In rng.Areas
        TempArray = EachRange.Value2
          If IsArray(TempArray) Then
            For rw = LBound(TempArray, 1) To UBound(TempArray, 1)
              For col = LBound(TempArray, 2) To UBound(TempArray, 2)
                'Check if value is a date
                  If IsDate(TempArray(rw, col)) Then
                    TempArray(rw, col) = CDate(TempArray(rw, col))
    
                'Check if value is a number
                  ElseIf IsNumeric(TempArray(rw, col)) Then
                    TempArray(rw, col) = CDbl(TempArray(rw, col))
    
                'Otherwise value is Text. Let's Trim it! (Remove any extraneous spaces)
                  Else
                    TempArray(rw, col) = Application.Trim(TempArray(rw, col))
    
                    'Change Case if the user wants to
                      If ChangeCase Then
                        TempArray(rw, col) = StrConv( _
                        TempArray(rw, col), ChangeCaseOption)
                      End If
                  End If
              Next col
            Next rw
          Else
            'Handle with Single Cell selected areas
              If IsDate(TempArray) Then 'If Date
                TempArray = CDate(TempArray)
              ElseIf IsNumeric(TempArray) Then 'If Number
                TempArray = CDbl(TempArray)
              Else 'Is Text
                TempArray = Application.Trim(TempArray)
                  'Handle case formatting (if necessary)
                    If ChangeCase Then
                      TempArray = StrConv(TempArray, ChangeCaseOption)
                    End If
              End If
          End If
    
        EachRange.Value2 = TempArray
    
      Next EachRange
    
    'Code Ran Succesfully!
    'MsgBox "Your data cleanse was successful!", vbInformation, "All Done!"
    
    End Sub
    
    ------------------------------------------------------------------------
    Function RangeHasFormulas(ByRef rng As Range) As Boolean
    
    'PURPOSE: Determine if given range has any formulas in it
    'AUTHOR: Ejaz Ahmed (www.StrugglingToExcel.Wordpress.com)
    'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
    
    Dim TempVar As Variant
    
    TempVar = rng.HasFormula
    
    'Test Range
      If IsNull(TempVar) Then
        'Some of cells have fromulas
          RangeHasFormulas = True
      Else
        If TempVar = True Then
          'All cells have formulas
            RangeHasFormulas = True
        Else
          'None of cells have formulas
            RangeHasFormulas = False
        End If
      End If
    
    End Function
    
    1 回复  |  直到 6 年前
        1
  •  1
  •   Ron Rosenfeld    6 年前

    该代码的问题是VBA IsDate 函数将使用逗号作为分隔符。所以呢 1,225 1-Jan-225 . 因为这不是一个合法的Excel值,所以它会被转换为一个负数(在 1-Jan-1900 ).

    如果您处理的只是将存储为字符串的数字转换为实数,那么您可以使用:

    Option Explicit
    Sub colaTextToNumbers()
        Dim R As Range
    
    'Can be set in many different ways
    Set R = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) 'for column A
    
    'Set R = Selection
    'Set R = whatever
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    With R
        .EntireColumn.NumberFormat = "General" 'or could limit this just to R, not entire column
        .Value = .Value
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    End Sub