मैं अन्य कार्यपुस्तिका में डेटा की कई शीट आयात कर रहा हूं और संख्याओं को संख्याओं में परिवर्तित करने का एक आसान तरीका चाहता हूं। इसलिए मुझे यह कोड मिला जिसने ठीक वही किया जो मैं चाहता था https://www.thespreadsheetguru.com/the-code-vault/2014/8/21/convert-numbers-stored-as-text

यह तेजी से और सुचारू रूप से चला जिसकी बहुत सराहना की गई, लेकिन जब मैंने डेटा के साथ काम करना शुरू किया तो मैंने एक विसंगति देखी। मैंने पाया कि दो सेल दो पूरी तरह से अलग-अलग संख्याओं में परिवर्तित हो गए थे। लिखने के समय ये केवल दो ही हैं जो मुझे मिले हैं, लेकिन यह काफी चिंताजनक है कि क्या और भी हो सकते हैं। एक उदाहरण स्ट्रिंग "1,225" -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
0
Vinnie Novido 8 अक्टूबर 2018, 15:34

1 उत्तर

सबसे बढ़िया उत्तर

उस कोड के साथ समस्या यह है कि VBA IsDate फ़ंक्शन अन्य बातों के अलावा, अल्पविराम को एक सीमांकक के रूप में उपयोग करेगा। अतः 1,225 को दिनांक 1-Jan-225 माना जाता है। चूंकि यह एक वैध एक्सेल मान नहीं है, यह एक ऋणात्मक संख्या में परिवर्तित हो जाता है (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
1
Ron Rosenfeld 8 अक्टूबर 2018, 20:01