[已解决]求助：excel自定义函数,将一个数的偶数个数、奇数个数、总个数组成一个新数

cmjcmj8888 · 发表于 2013-10-7 03:39

本帖最后由 cmjcmj8888 于 2013-10-7 13:39 编辑

求助：excel自定义函数，将一个数的偶数个数、奇数个数、总个数，重新组成一个数。
如：134565，偶数个数2、奇数个数4、总个数6，得到一个新数246
如：24678957，偶数个数4、奇数个数4、总个数8，得到448

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-10-7 08:08

本帖最后由 hwc2ycy 于 2013-10-7 08:09 编辑

Function getNewNumber(lNumber As String) As String
'参数可传入纯数值或数值型字符串,不能带小数点，不能是科学计数法表示的数字
Dim bOdd As Byte, bEven As Byte
Dim i As Integer
Dim lSum As Long
Dim bTemp As Byte
'检测参数是否是数字
If lNumber Like "*[.Ee]*" Then Exit Function
If Not VBA.IsNumeric(lNumber) Then Exit Function
For i = 1 To Len(lNumber)
bTemp = Mid(lNumber, i, 1)
Select Case bTemp Mod 2
Case 0
'偶数
bEven = bEven + 1
Case 1
'奇数
bOdd = bOdd + 1
End Select
'和
lSum = lSum + bTemp
Next
Debug.Print lNumber, bEven, bOdd, lSum
'结果直接输出成字符串，省去求和计算
getNewNumber = bEven & bOdd & lSum
End Function
Sub test()
MsgBox getNewNumber(12345)
MsgBox getNewNumber("23423423232340920349234")
MsgBox getNewNumber("00000")
MsgBox getNewNumber("11111")
MsgBox getNewNumber("1.1")
MsgBox getNewNumber(2E+100)
MsgBox getNewNumber(&H100)
MsgBox getNewNumber(100)
End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2013-10-7 07:58

Function getNewNumber(lNumber As String) As String
Dim bOdd As Byte, bEven As Byte
Dim i As Integer
Dim lSum As Long
Dim bTemp As Byte
Debug.Print Len(lNumber)
If Not VBA.IsNumeric(lNumber) Then Exit Function
For i = 1 To Len(lNumber)
bTemp = Mid(lNumber, i, 1)
Select Case bTemp Mod 2
Case 0
bEven = bEven + 1
Case 1
bOdd = bOdd + 1
End Select
lSum = lSum + bTemp
Next
Debug.Print lNumber, bEven, bOdd, lSum
getNewNumber = bEven & bOdd & lSum
End Function
Sub test()
MsgBox getNewNumber(12345)
MsgBox getNewNumber("23423423232340920349234")
MsgBox getNewNumber("00000")
MsgBox getNewNumber("11111")
End Sub

复制代码

hwc2ycy · 发表于 2013-10-7 08:08

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

本帖最后由 hwc2ycy 于 2013-10-7 08:09 编辑

Function getNewNumber(lNumber As String) As String
'参数可传入纯数值或数值型字符串,不能带小数点，不能是科学计数法表示的数字
Dim bOdd As Byte, bEven As Byte
Dim i As Integer
Dim lSum As Long
Dim bTemp As Byte
'检测参数是否是数字
If lNumber Like "*[.Ee]*" Then Exit Function
If Not VBA.IsNumeric(lNumber) Then Exit Function
For i = 1 To Len(lNumber)
bTemp = Mid(lNumber, i, 1)
Select Case bTemp Mod 2
Case 0
'偶数
bEven = bEven + 1
Case 1
'奇数
bOdd = bOdd + 1
End Select
'和
lSum = lSum + bTemp
Next
Debug.Print lNumber, bEven, bOdd, lSum
'结果直接输出成字符串，省去求和计算
getNewNumber = bEven & bOdd & lSum
End Function
Sub test()
MsgBox getNewNumber(12345)
MsgBox getNewNumber("23423423232340920349234")
MsgBox getNewNumber("00000")
MsgBox getNewNumber("11111")
MsgBox getNewNumber("1.1")
MsgBox getNewNumber(2E+100)
MsgBox getNewNumber(&H100)
MsgBox getNewNumber(100)
End Sub

复制代码

cmjcmj8888 · 发表于 2013-10-7 13:22

hwc2ycy 发表于 2013-10-7 07:58

求助题目更改为：输入一个正整数，求在这个数的各个数位中的偶数个数、奇数个数、总个数，并组成一个新数。如：输入3457，得134，再得123.
（1）.将lSum = bEven + bOdd，移到下面（移出循环）,运行后是正确的。有无改进？
（2）.下面的sub test(),有什么用？？？？？？
Function getNewNumber(lNumber As String) As String '输入一个正整数，求在这个数的各个数位中的偶数个数、奇数个数、总个数，并组成一个新数。如：输入3457，得134，再得123.
Dim bOdd As Byte, bEven As Byte
Dim i As Integer
Dim lSum As Long
Dim bTemp As Byte

Debug.Print Len(lNumber)
If Not VBA.IsNumeric(lNumber) Then Exit Function
For i = 1 To Len(lNumber)
      bTemp = Mid(lNumber, i, 1)
      Select Case bTemp Mod 2
         Case 0
            bEven = bEven + 1
         Case 1
            bOdd = bOdd + 1
      End Select
Next
lSum = bEven + bOdd    '从上面移除循环
Debug.Print lNumber, bEven, bOdd, lSum
getNewNumber = bEven & bOdd & lSum
End Function

yezhikang · 发表于 2013-10-7 23:27

学习了

		自动登录	找回密码
密码			注册

[已解决]求助：excel自定义函数,将一个数的偶数个数、奇数个数、总个数组成一个新数

相关帖子