字符串转换差异
String conversion discrepancy
我正在将多个 sheet 数据导入另一个工作簿,并且想要一种将数字字符串转换为数字的简单方法。所以我发现这段代码完全符合我的要求 https://www.thespreadsheetguru.com/the-code-vault/2014/8/21/convert-numbers-stored-as-text
它 运行 快速而流畅,非常感谢,但是当我开始处理数据时,我发现了一个差异。我发现两个单元格变成了两个完全不同的数字。在撰写本文时,这些是我发现的仅有的两个,但如果还有更多,我会非常担心。一个例子是字符串“1,225”变成了-611779。 (是的,我使用的是小数点逗号)
出于某种原因,它认为这两个 "strings" 数字是完全不同的东西。然而,在另一个 sheet 中,相同的数字已被正确转换。
我现在的问题是:是否有某些原因导致这两个(可能还有更多单元格)导致脚本无法正确转换这些数字。还是代码有缺陷?
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
该代码的问题在于 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
我正在将多个 sheet 数据导入另一个工作簿,并且想要一种将数字字符串转换为数字的简单方法。所以我发现这段代码完全符合我的要求 https://www.thespreadsheetguru.com/the-code-vault/2014/8/21/convert-numbers-stored-as-text
它 运行 快速而流畅,非常感谢,但是当我开始处理数据时,我发现了一个差异。我发现两个单元格变成了两个完全不同的数字。在撰写本文时,这些是我发现的仅有的两个,但如果还有更多,我会非常担心。一个例子是字符串“1,225”变成了-611779。 (是的,我使用的是小数点逗号)
出于某种原因,它认为这两个 "strings" 数字是完全不同的东西。然而,在另一个 sheet 中,相同的数字已被正确转换。
我现在的问题是:是否有某些原因导致这两个(可能还有更多单元格)导致脚本无法正确转换这些数字。还是代码有缺陷?
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
该代码的问题在于 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