|
楼主 |
发表于 2024-4-22 23:17
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 micch 于 2024-4-23 11:39 编辑
按位计算写个函数- Option Explicit
- Sub TEST()
- Dim res
- res = Solver(1714, 190)
- Debug.Print Join(res)
- End Sub
- Function Solver(a As Long, b As Long)
- Dim res(9) As String, i As Integer
- If a > b Then Swap a, b
- For i = 0 To 9
- res(i) = CountNum(b, i) - CountNum(a - 1, i)
- Next
- Solver = res
- End Function
- Function Swap(a As Long, b As Long)
- Dim c As Long
- c = a: a = b: b = c
- End Function
- Function CountNum(n0 As Long, i0 As Integer) As Long
- Dim L0 As Integer, i As Integer
- Dim Cnt As Long
- Dim l As Long, r As Long, p As Long
- L0 = VBA.Len(n0)
- For i = 1 - (i0 = 0) To L0 Step 1
- p = 10 ^ (L0 - i)
- If i > 1 Then
- l = VBA.Val(VBA.Left(n0, i - 1))
- Cnt = Cnt + l * p
- If i0 = 0 Then Cnt = Cnt - p
- End If
- Select Case VBA.CInt(VBA.Val(VBA.Mid(n0, i, 1)))
- Case Is = i0
- Cnt = Cnt + 1 + VBA.Val(VBA.Mid(n0, i + 1))
- Case Is > i0
- Cnt = Cnt + p
- End Select
- Next
- CountNum = Cnt
- End Function
复制代码
- Option Explicit
- Sub TEST() '主程序输入 a,b 返回10个元素的数组,分别对应0~9的数量
- Dim res
- res = Solver(1714, 190) '两个正整数,大小不一
- Debug.Print Join(res)
- End Sub
- Function Solver(a As Long, b As Long)
- Dim res(9) As String, i As Integer, c As Long
- If a > b Then c = a: a = b: b = c '大小相反的话,交换两个数字
- For i = 0 To 9 '分别统计0~9每个数字的数量
- res(i) = CountNum(b, i) - CountNum(a - 1, i)
- Next
- Solver = res
- End Function
- '统计从0~n0每一个数字中,i0出现的次数
- Function CountNum(n0 As Long, i0 As Integer) As Long
- Dim L0 As Integer, i As Integer
- Dim Cnt As Long, p As Long
- L0 = VBA.Len(n0)
- '如果i0是0,从第二位开始,1~9从第一位开始
- '统计每一位的i0的数量
- For i = 1 - (i0 = 0) To L0 Step 1
- p = 10 ^ (L0 - i) '数位右侧组合的总数量
- If i > 1 Then '从第二位开始,计算左侧和右侧合计的组合有多少数字
- Cnt = Cnt + VBA.Val(VBA.Left(n0, i - 1)) * p
- If i0 = 0 Then Cnt = Cnt - p '0不能在首位,删除多加的P
- End If
- '单独统计右侧组合的数量
- Select Case VBA.CInt(VBA.Val(VBA.Mid(n0, i, 1)))
- Case Is = i0
- Cnt = Cnt + 1 + VBA.Val(VBA.Mid(n0, i + 1))
- Case Is > i0
- Cnt = Cnt + p
- End Select
- Next
- CountNum = Cnt
- End Function
复制代码 |
评分
-
1
查看全部评分
-
|