[已解决]VBA整数删数字后最小数

grf1973

yorkchenshunan 发表于 2016-3-30 13:48
你的代码，尾巴处理有问题，如输入12300111789，删除5位，显示不了删除8/9

嗯，加一句代码就行了。

1. Sub tt()
   
2.     Dim L, isfirst As Boolean
   
3.     x = InputBox("请输入要截取的数字串", "", "80317902254297017652") '输入数字串
   
4.     jqs = Val(InputBox("请输入的剔除数字的个数", "", 9)) '截取数(需要剔除数字的个数)
   
5.     msg = "原数：" & x & Chr(10) & "删除个数：" & jqs & Chr(10)
   
6.     n = Len(x) - jqs   '要保留的个数
   
7.     For k = n To 1 Step -1    '要保留k位数
   
8.         If k = n Then isfirst = True Else isfirst = False      '看看是不是第一位
   
9.         L = Len(x) - k + 1       '去掉后面k-1位，取前半段
   
10.         y = getmin(Left(x, L), isfirst)      '找到最小值，如果是第一次取值，不含0
    
11.         res = res & y
    
12.         p = InStr(x, y)      '最小值的位置p
    
13.         jq = jq & Left(x, p - 1)     'p前各位即为删除的数字
    
14.         x = Mid(x, p + 1)        'p后各位即为下一次截取的字符串
    
15.     Next
    
16.     jq = jq & x     '加上“尾巴"
    
17.     MsgBox msg & "先后删除数字：" & jq & Chr(10) & "删除后最小：" & res
    
18. End Sub
    
19. Function getmin(x, isfirst As Boolean)      '得到字符串x中的最小数。如果是第一次取值，不含0。
    
20.     If isfirst Then k = 1 Else k = 0
    
21.     For i = k To 9
    
22.         If InStr(x, i) Then Exit For
    
23.     Next
    
24.     getmin = i
    
25. End Function
    

复制代码

香川群子

grf1973 发表于 2016-3-30 12:03

你的思路不错。用Instr检查效率更高！

代码改写一下：（不用函数，直接整合在循环内部）

1. Sub test1() 'by kagawa
   
2.    
   
3.     s = InputBox("", "", "80317902254297017652")
   
4.     n = Val(InputBox("n=", "", 9))
   
5.    
   
6.     r = 1
   
7.     For i = 1 To n
   
8.         t = Mid(s, r, n + i - r + 1) '截取有效个数的待挑选最小值字符
   
9.         For j = IIf(i = 1, 1, 0) To 9 '首位1开始，其余0开始检查
   
10.             r2 = InStr(t, j): If r2 Then Exit For '检查到含有时退出 得到本区间段中第1个最小值的位置r2
    
11.         Next
    
12.         s1 = s1 & Left(t, r2 - 1): If Len(s1) = n Then Exit For '该位置之前的数字要剔除 剔除数=n时退出
    
13.         s2 = s2 & Mid(t, r2, 1): r = r + r2 '合并保留数字 并更新下一个检查起始位置r
    
14.     Next
    
15.     s2 = s2 & Mid(s, r + r2 - 1) '剔除数=n结束后 保留数字要加上剩余部分数字     
    
16. 
    
17.     Debug.Print n & "/" & Len(s) & vbCr & s & vbCr & s1 & vbCr & s2
    
18.     MsgBox s & vbCr & s1 & vbCr & s2
    
19.    
    
20. End Sub

复制代码

香川群子

如果需要更清晰的表示提取结果，那么稍复杂一点：

1. Sub test2() 'by kagawa
   
2.    
   
3.     s = InputBox("", "", "80317902254297017652")
   
4.     n = Val(InputBox("n=", "", 9))
   
5.    
   
6.     r = 1
   
7.     For i = 1 To n
   
8.         t = Mid(s, r, n + i - r + 1)
   
9.         For j = IIf(i = 1, 1, 0) To 9
   
10.             r2 = InStr(t, j): If r2 Then Exit For
    
11.         Next
    
12.         s1 = s1 & Left(t, r2 - 1)
    
13.         If Len(s1) = n Then
    
14.             s2 = s2 & Left(t, r2 - 1)
    
15.             s3 = s3 & String(r2 - 1, "-") & Mid(s, r + r2 - 1)
    
16.             s4 = s4 & Mid(s, r + r2 - 1)
    
17.             Exit For
    
18.         Else
    
19.             s2 = s2 & Left(t, r2 - 1) & "-"
    
20.             s3 = s3 & String(r2 - 1, "-") & Mid(t, r2, 1)
    
21.             s4 = s4 & Mid(t, r2, 1)
    
22.             r = r + r2
    
23.         End If
    
24.     Next
    
25.    
    
26.     Debug.Print n & "/" & Len(s) & vbCr & s & vbCr & s1 & vbCr & s2 & vbCr & s3 & vbCr & s4
    
27.     MsgBox s & vbCr & s1 & vbCr & s2 & vbCr & s3 & vbCr & s4
    
28.    
    
29. End Sub
    

复制代码

kevinch

凑个热闹

1. Sub test()
   
2. Dim Str, N, Result$, Tmp$, L&, I&
   
3. Str = Application.InputBox("请输入原始数值：", , , , , , , 2)
   
4. If Str = False Then Exit Sub
   
5. Result = CStr(Str)
   
6. N = Application.InputBox("请输入要清除的数字个数：", , , , , , 1)
   
7. If N = False Then Exit Sub
   
8. L = Len(Result) - N
   
9. Do While Len(Result) > L
   
10.     For I = 1 To Len(Result)
    
11.         If Val(Mid(Result, I, 1)) > Val(Mid(Result, I + 1, 1)) Then
    
12.             Tmp = Tmp & Mid(Result, I, 1) & " "
    
13.             Result = Left(Result, I - 1) & Right(Result, Len(Result) - I)
    
14.             Exit For
    
15.         End If
    
16.     Next I
    
17. Loop
    
18. MsgBox "原始数字：" & Str & vbCrLf & "去除数字个数：" & N & vbCrLf & "去除数字为：" & Tmp & vbCrLf & "最小结果为：" & Val(Result)
    
19. End Sub

复制代码

kevinch

还是用for吧

1. Sub test()
   
2. Dim Str, N, Result$, Tmp$, L&, I&, T&
   
3. Str = Application.InputBox("请输入原始数值：", , , , , , , 2)
   
4. If Str = False Then Exit Sub
   
5. Result = CStr(Str)
   
6. N = Application.InputBox("请输入要清除的数字个数：", , , , , , 1)
   
7. If N = False Then Exit Sub
   
8. For T = 1 To N
   
9.     For I = 1 To Len(Result)
   
10.         If Val(Mid(Result, I, 1)) > Val(Mid(Result, I + 1, 1)) Then
    
11.             Tmp = Tmp & Mid(Result, I, 1) & " "
    
12.             Result = Left(Result, I - 1) & Right(Result, Len(Result) - I)
    
13.             Exit For
    
14.         End If
    
15.     Next I
    
16. Next T
    
17. MsgBox "原始数字：" & Str & vbCrLf & "去除数字个数：" & N & vbCrLf & "去除数字为：" & Tmp & vbCrLf & "最小结果为：" & Val(Result)
    
18. End Sub

复制代码

香川群子

yorkchenshunan 发表于 2016-3-30 13:48
你的代码，尾巴处理有问题，如输入12300111789，删除5位，显示不了删除8/9

确实存在这个问题bug。

解决办法是，在输入的数字串后末尾添加1个"0"，强制进入检查模式。
但是，注意最后输出结果时要去掉这个多加的"0"。

简化版代码：

1. Sub test1() 'by kagawa
   
2.    
   
3. '    s = InputBox("", "", "80317902254297017652")
   
4. '    n = Val(InputBox("n=", "", 9))
   
5.     s = "80317902254297017652": n = 9
   
6.     s = "12300111789": n = 5
   
7.    
   
8.     m = Len(s): s = s & "0"
   
9.     r = 1
   
10.     For i = 1 To m - n + 1
    
11.         t = Mid(s, r, n + i - r + 1)
    
12.         For j = IIf(i = 1, 1, 0) To 9
    
13.             r2 = InStr(t, j): If r2 Then Exit For
    
14.         Next
    
15.         s1 = s1 & Left(t, r2 - 1): If Len(s1) = n Then Exit For
    
16.         s2 = s2 & Mid(t, r2, 1): r = r + r2
    
17.     Next
    
18.     s = Left(s, m): s2 = s2 & Mid(s, r + r2 - 1)
    
19.    
    
20.     Debug.Print n & "/" & m & vbCr & s & vbCr & s1 & vbCr & s2
    
21.     MsgBox s & vbCr & s1 & vbCr & s2
    
22.    
    
23. End Sub

复制代码

完整版代码也同样处理：

1. Sub test2() 'by kagawa
   
2.    
   
3. '    s = InputBox("", "", "80317902254297017652")
   
4. '    n = Val(InputBox("n=", "", 9))
   
5. '    s = "80317902254297017652": n = 9
   
6.     s = "12300111789": n = 5
   
7.    
   
8.     m = Len(s): s = s & "0"
   
9.     r = 1
   
10.     For i = 1 To m - n + 1
    
11.         t = Mid(s, r, n + i - r + 1)
    
12.         For j = IIf(i = 1, 1, 0) To 9
    
13.             r2 = InStr(t, j): If r2 Then Exit For
    
14.         Next
    
15.         s1 = s1 & Left(t, r2 - 1)
    
16.         If Len(s1) = n Then
    
17.             s = Left(s, m)
    
18.             s2 = s2 & Left(T, r2 - 1) & String(m - r - r2 + 2, "-")
    
19.             s3 = s3 & String(r2 - 1, "-") & Mid(s, r + r2 - 1)
    
20.             s4 = s4 & Mid(s, r + r2 - 1)
    
21.             Exit For
    
22.         Else
    
23.             s2 = s2 & Left(t, r2 - 1) & "-"
    
24.             s3 = s3 & String(r2 - 1, "-") & Mid(t, r2, 1)
    
25.             s4 = s4 & Mid(t, r2, 1)
    
26.             r = r + r2
    
27.         End If
    
28.     Next
    
29.    
    
30.     Debug.Print n & "/" & Len(s) & vbCr & s & vbCr & s1 & vbCr & s2 & vbCr & s3 & vbCr & s4
    
31.     MsgBox s & vbCr & s1 & vbCr & s2 & vbCr & s3 & vbCr & s4
    
32.    
    
33. End Sub

复制代码

香川群子

最终测试还是这个版本速度效率最好。

因为，如果剔除数在前半段，就可以提前终止了。

1. Sub test3() 'by kagawa
   
2.     Dim i&, j&, n&, r&, r2&, s$, s1$, s2$, t$
   
3. 
   
4. '    s = "80317902254297017652": n = 9
   
5.     s = "12300111227829": n = 5
   
6.    
   
7.     r = 1
   
8.     For i = 1 To Len(s) - n
   
9.         t = Mid(s, r, n + i - r + 1)
   
10.         For j = IIf(i = 1, 1, 0) To 9
    
11.             r2 = InStr(t, j): If r2 Then Exit For
    
12.         Next
    
13.         s1 = s1 & Left(t, r2 - 1): If Len(s1) = n Then Exit For
    
14.         s2 = s2 & Mid(t, r2, 1): r = r + r2
    
15.     Next
    
16.     If Len(s1) < n Then s1 = s1 & Mid(t, r2 + 1) Else s2 = s2 & Mid(s, r + r2 - 1)
    
17.    
    
18.     Debug.Print n & "/" & Len(s) & vbCr & s & vbCr & s1 & vbCr & s2
    
19.     MsgBox s & vbCr & s1 & vbCr & s2
    
20. End Sub

复制代码