[COLOR=#008000]'tested data
' num -divisor divisor Abs(divisor-num)
'mod(4,2) (2) 2 after loop 4-4 = 0
'mod(4,3) (1) 3 3-4 =-1
'mod(4,4) (0) 4 4-4 = 0
'mod(4,5) (-1) 5 5-4 = 1
'mod(4.4,2) (2.4) 2 4-4.4 = 0.4
'mod(4.6,2) (2.6) 2 4-6.4 = 0.6
'mod(0,2) 2 0
'mod(2,0) (catch error at 0) 2 return xlError: #DIV/0!
'mod(FALSE,2) 2 0
'mod(text,2) (catch error at text) 2 return xlError: #VALUE!
'mod(xlError,2) (catch error at xlError)2 return xlError...
'*Note:
'Han che: Ham fMod hien tai chi co the nhan tham chieu la doi so, hoac cell.
'Algorithms:
'step 1: check input value...
'step 2: processing data...
[/COLOR]
Function fMod(ByVal num As Variant, ByVal divisor As Variant) As Variant
Dim iTmp As Double
Dim wsf As WorksheetFunction
Set wsf = Application.WorksheetFunction
[COLOR=#008000] 'Right here, when argument not vaild.
'code will be error [error 13: type mismatch] first
'and return xlError as #VALUE! in Microsoft Excel and stop !
[/COLOR]
[COLOR=#008000] 'step 1: check input value is valid
[/COLOR] If IsError(num) Then: fMod = procXlError(num): Exit Function[COLOR=#008000] 'iserror?[/COLOR]
If IsError(divisor) Then: fMod = procXlError(num): Exit Function
If wsf.IsNonText(num) And wsf.IsNonText(divisor) Then[COLOR=#008000] 'isnontext ?[/COLOR]
Select Case num [COLOR=#008000]'exceptions case[/COLOR]
Case 0: fMod = 0: Exit Function
Case Else
If divisor = 0 Then
fMod = CVErr(xlErrDiv0): Exit Function
Else
GoTo lxulychung
End If
End Select
Else
fMod = CVErr(xlErrValue): Exit Function
End If
[COLOR=#008000]'step 2: processing data...
[/COLOR][COLOR=#0000ff]lxulychung:
[/COLOR] iTmp = divisor
Do Until iTmp > num - divisor
iTmp = iTmp + divisor
Loop
fMod = Abs(iTmp - num)
Set wsf = Nothing
End Function
Function procXlError(ByVal cll As Variant) As Variant
Select Case cll
Case CVErr(xlErrName): procXlError = CVErr(xlErrName)
Case CVErr(xlErrDiv0): procXlError = CVErr(xlErrDiv0)
Case CVErr(xlErrValue): procXlError = CVErr(xlErrValue)
Case CVErr(xlErrNum): procXlError = CVErr(xlErrNum)
Case CVErr(xlErrRef): procXlError = CVErr(xlErrRef)
Case CVErr(xlErrNA): procXlError = CVErr(xlErrNA)
Case CVErr(xlErrNull): procXlError = CVErr(xlErrNull)
End Select
End Function
