Excel宏类型的转换

最新推荐文章于 2021-05-17 05:46:07 发布

原创最新推荐文章于 2021-05-17 05:46:07 发布 · 1.6k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#excel #function #validation #date #integer #string

人在Sungard 专栏收录该内容

16 篇文章

订阅专栏

本文介绍了一系列用于Visual Basic中不同类型变量转换的自定义函数。这些函数可以将输入的Variant类型变量安全地转换为Currency、Double、Integer、Long、Single、String、Date及Boolean等类型，并在遇到无效输入时返回默认值。

Function gcVBCur(ByVal vVariable As Variant) As Currency
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   gcVBCur = CCur(0)

   'Validation
   If IsNull(vVariable) Or Not IsNumeric(vVariable) Then
      Exit Function
   End If

'Set return function value
gcVBCur = CCur(vVariable)

End Function

Function gdVBDbl(ByVal vVariable As Variant) As Double
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   gdVBDbl = CDbl(0)

   'Validation
   If IsNull(vVariable) Or Not IsNumeric(vVariable) Then
      Exit Function
   End If

'Set return function value
gdVBDbl = CDbl(vVariable)

End Function

Function gnVBInt(ByVal vVariable As Variant) As Integer
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   gnVBInt = CInt(0)

   'Validation
   If IsNull(vVariable) Or Not IsNumeric(vVariable) Then
      Exit Function
   End If

'Set return function value
gnVBInt = CInt(vVariable)

End Function

Function glVBLng(ByVal vVariable As Variant) As Long
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   glVBLng = CLng(0)

   'Validation
   If IsNull(vVariable) Or Not IsNumeric(vVariable) Then
      Exit Function
   End If

'Set return function value
glVBLng = CLng(vVariable)

End Function

Function ggVBSng(ByVal vVariable As Variant) As Single
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   ggVBSng = CSng(0)

   'Validation
   If IsNull(vVariable) Or Not IsNumeric(vVariable) Then
      Exit Function
   End If

'Set return function value
ggVBSng = CSng(vVariable)

End Function

Function gsVBStr(ByVal vVariable As Variant) As String
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   gsVBStr = ""

   'Validation
   If IsNull(vVariable) Then
      Exit Function
   End If

'Set return function value
gsVBStr = CStr(vVariable)

End Function

Function gtVBDate(ByVal vVariable As Variant) As Date
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set return function value
   gtVBDate = DateValue(gtVBDateTime(vVariable))

End Function

Function gtVBTime(ByVal vVariable As Variant) As Date
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set return function value
   gtVBTime = TimeValue(gtVBDateTime(vVariable))

End Function

Function gtVBDateTime(ByVal vVariable As Variant) As Date
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   gtVBDateTime = CDate(0)

   'Declare
   Dim ldtmDateTime     As Date

   'Set default value
   ldtmDateTime = CDate(0)

   Select Case VarType(vVariable)
      Case vbDate
         ldtmDateTime = vVariable
      Case vbSingle, vbDouble, vbInteger, vbLong
         ldtmDateTime = CDate(vVariable)
      Case vbString
         If IsDate(vVariable) Then
            ldtmDateTime = CDate(vVariable)
         End If
      Case Else
   End Select

   'Set return function value
   gtVBDateTime = ldtmDateTime

End Function

Function gbVBBool(ByVal vVariable As Variant) As Boolean
'-------------------------------------------------------------------------------------------
'Note    : Integra-t.com global Function
'-------------------------------------------------------------------------------------------
   On Error Resume Next

   'Set default function value
   gbVBBool = False

   'Set return function value
   Select Case VarType(vVariable)
      Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal
         gbVBBool = CBool(vVariable)
      Case vbDate
         If vVariable <> CDate(0) Then
            gbVBBool = True
         End If
      Case vbString
         If IsNumeric(vVariable) Then
            gbVBBool = CBool(Val(vVariable))
         ElseIf Len(CStr(vVariable)) > 0 Then
            Select Case UCase$(vVariable)
               Case "TRUE", "YES", "Y"
                  gbVBBool = True
            End Select
         End If
      Case vbBoolean
         gbVBBool = vVariable
      Case Else
   End Select

End Function