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

vbyou127 · 发表于 2016-3-29 17:12

VBA整数删数字后最小数

请在整数n=83179254297017652中删除9个数字，使得余下的数字按原次序组成的新数最小

用msgbox提示输入整数，输入删除数字个数

先后删除哪些数字

删除后最小

答案:12017652

最佳答案

yorkchenshunan

2016-3-30 11:06

本帖最后由 yorkchenshunan 于 2016-3-30 13:39 编辑

按照我的逻辑，先后删除的是3/4/5/6/8，过程如下

Sub jisuan()
Dim ar, n%, m As Single, p%, r%, min1%, min2%, min3%, min%, br, cr, inp$
inp = Application.InputBox("说明：请输整数", "请输入任意整数", , , , , , 2)
If Not IsNumeric(inp) Then
MsgBox "输入有误"
Exit Sub
End If
ReDim ar(1 To Len(inp), 1 To 2) As Integer
For n = 1 To Len(inp)
ar(n, 1) = n
ar(n, 2) = Mid(inp, n, 1)
Next n
Do
m = Application.InputBox("说明：请输入1-" & Len(inp) - 1 & "之间的整数", "请输入删除数字个数", , , , , , 1)
Loop Until Int(m) = m And m >= 1 And m <= 16
min = 1
min3 = 1
ReDim br(1 To Len(inp) - m)
ReDim cr(1 To m)
For p = 1 To Len(inp) - m
min2 = 10
For r = min To p + m
If ar(r, 2) < min2 Then
min1 = ar(r, 1)
min2 = ar(r, 2)
End If
Next r
If min1 > min Then
For r = min To min1 - 1
cr(min3) = ar(r, 2)
min3 = min3 + 1
Next r
End If
min = min1 + 1
br(p) = min2
Next p
If min3 <= m Then
For p = 1 To m + 1 - min3
cr(m + 1 - p) = ar(UBound(ar) - p + 1, 2)
Next p
End If
MsgBox "先后删除数字：" & Join(cr, "，") & Chr(10) & "答案：" & Join(br, "")
End Sub

复制代码

yorkchenshunan · 发表于 2016-3-29 18:53

Sub jisuan()
Dim ar(1 To 17, 1 To 2) As Integer, n%, m As Single, p%, r%, min1%, min2%, min%, br
For n = 1 To 17
ar(n, 1) = n
ar(n, 2) = Mid("83179254297017652", n, 1)
Next n
Do
m = Application.InputBox("说明：请输入1-16之间的整数", "请输入删除数字个数", , , , , , 1)
Loop Until Int(m) = m And m >= 1 And m <= 16
min = 2
ReDim br(1 To 17 - m)
For p = 1 To 17 - m
min2 = 9
For r = min To p + m
If ar(r, 2) < min2 Then
min1 = ar(r, 1)
min2 = ar(r, 2)
End If
Next r
min = min1 + 1
br(p) = min2
Next p
MsgBox "答案：" & Join(br, "")
End Sub

复制代码

vbyou127 · 发表于 2016-3-29 18:59

yorkchenshunan 发表于 2016-3-29 18:53

怎么不行啊

yorkchenshunan · 发表于 2016-3-29 19:11

请描述如何不行？我的电脑上是可以的。

vbyou127 · 发表于 2016-3-29 21:16

yorkchenshunan 发表于 2016-3-29 19:11
请描述如何不行？我的电脑上是可以的。

无法输入这个数83179254297017652

yorkchenshunan · 发表于 2016-3-29 21:42

你并没有要求这个数也要输入啊？

yorkchenshunan · 发表于 2016-3-29 21:49

本帖最后由 yorkchenshunan 于 2016-3-30 08:35 编辑

Sub jisuan()
Dim ar, n%, m As Single, p%, r%, min1%, min2%, min%, br, inp$
inp = Application.InputBox("说明：请输整数", "请输入任意整数", , , , , , 2)
If Not IsNumeric(inp) Then
MsgBox "输入有误"
Exit Sub
End If
ReDim ar(1 To Len(inp), 1 To 2) As Integer
For n = 1 To Len(inp)
ar(n, 1) = n
ar(n, 2) = Mid(inp, n, 1)
Next n
Do
m = Application.InputBox("说明：请输入1-" & Len(inp) - 1 & "之间的整数", "请输入删除数字个数", , , , , , 1)
Loop Until Int(m) = m And m >= 1 And m <= 16
min = 1
ReDim br(1 To Len(inp) - m)
For p = 1 To Len(inp) - m
min2 = 9
For r = min To p + m
If ar(r, 2) < min2 Then
min1 = ar(r, 1)
min2 = ar(r, 2)
End If
Next r
min = min1 + 1
br(p) = min2
Next p
MsgBox "答案：" & Join(br, "")
End Sub

复制代码

vbyou127 · 发表于 2016-3-29 22:00

yorkchenshunan 发表于 2016-3-29 21:49

输入1至16有何用，一定要输入多位大数83179254297017652

yorkchenshunan · 发表于 2016-3-30 08:35

Sub jisuan()
Dim ar, n%, m As Single, p%, r%, min1%, min2%, min%, br, inp$
inp = Application.InputBox("说明：请输整数", "请输入任意整数", , , , , , 2)
If Not IsNumeric(inp) Then
MsgBox "输入有误"
Exit Sub
End If
ReDim ar(1 To Len(inp), 1 To 2) As Integer
For n = 1 To Len(inp)
ar(n, 1) = n
ar(n, 2) = Mid(inp, n, 1)
Next n
Do
m = Application.InputBox("说明：请输入1-" & Len(inp) - 1 & "之间的整数", "请输入删除数字个数", , , , , , 1)
Loop Until Int(m) = m And m >= 1 And m <= 16
min = 1
ReDim br(1 To Len(inp) - m)
For p = 1 To Len(inp) - m
min2 = 9
For r = min To p + m
If ar(r, 2) < min2 Then
min1 = ar(r, 1)
min2 = ar(r, 2)
End If
Next r
min = min1 + 1
br(p) = min2
Next p
MsgBox "答案：" & Join(br, "")
End Sub

复制代码

vbyou127 · 发表于 2016-3-30 09:50

本帖最后由 vbyou127 于 2016-3-30 10:07 编辑

yorkchenshunan 发表于 2016-3-30 08:35

结果正确，请补上先后删除了哪些数字

假设用整数13425638694，结果如下表述最好

请输入整数:13425638694
输入删除个数:5
先后删除数字:4,3,6,5,8
删除后最小:123694

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