[已解决]求助一个VBA代码，可以自动计算并显示剩余的数字段区间

robinaqiu · 发表于 2017-8-7 16:30

求助可以计算并显示去掉对应单元格中的数据点、数据区间或者两种混合形式的代码，具体想实现的效果请见附件，谢谢！

最佳答案

大灰狼1976

2017-8-8 15:50

给你一个附件。
说明，选中（不是编辑）A列某个单元格时，会跳出输入框，输入剔除数据（注意格式以,号或-号分隔规则不要变）后，B列会自动显示结果。

大灰狼1976 · 发表于 2017-8-7 17:03

没想出简洁的方法，就这样吧。

Sub aaa()
Dim arr, brr, brr1, crr, i&, j&, k&, s$
arr = [e2].CurrentRegion
For i = 2 To UBound(arr)
ReDim crr(Split(arr(i, 1), "-")(0) To Split(arr(i, 1), "-")(UBound(Split(arr(i, 1), "-"))))
brr = Split(arr(i, 1), ",")
For j = 0 To UBound(brr)
brr1 = Split(brr(j), "-")
For k = brr1(0) To brr1(1)
crr(k) = 1
Next k
Next j
brr = Split(arr(i, 2), ",")
For j = 0 To UBound(brr)
brr1 = Split(brr(j), "-")
For k = brr1(0) To brr1(UBound(brr1))
crr(k) = ""
Next k
Next j
For j = LBound(crr) To UBound(crr) - 1
If crr(j) = 1 Then
For k = j + 1 To UBound(crr)
If crr(k) = "" Then Exit For
Next k
s = s & "," & j & "-" & k - 1
j = k
End If
Next j
arr(i, 3) = Mid(s, 2)
s = ""
Next i
[e2].Resize(UBound(arr), 3) = arr
End Sub

复制代码

robinaqiu · 发表于 2017-8-8 11:12

非常感谢版主的回答，试了一下可以完美运行，如果我想要实现跳出一个输入框来实现将输入的内容从本行的e列剔除的话要怎么样实现呢？从哪里添加这个input对话框比较合理呢，菜鸟一个希望版主能够再指导一下，谢谢

大灰狼1976 · 发表于 2017-8-8 11:16

你的意思是，你输入一次，每一行都剔除相同的内容？

大灰狼1976 · 发表于 2017-8-8 11:20

原代码作了最小改动。

Sub aaa()
Dim arr, brr, brr1, crr, i&, j&, k&, s$, s1$
arr = [e2].CurrentRegion
s1 = InputBox("Pls Input...")
For i = 2 To UBound(arr)
ReDim crr(Split(arr(i, 1), "-")(0) To Split(arr(i, 1), "-")(UBound(Split(arr(i, 1), "-"))))
brr = Split(arr(i, 1), ",")
For j = 0 To UBound(brr)
brr1 = Split(brr(j), "-")
For k = brr1(0) To brr1(1)
crr(k) = 1
Next k
Next j
brr = Split(s1, ",")
For j = 0 To UBound(brr)
brr1 = Split(brr(j), "-")
For k = brr1(0) To brr1(UBound(brr1))
crr(k) = ""
Next k
Next j
For j = LBound(crr) To UBound(crr) - 1
If crr(j) = 1 Then
For k = j + 1 To UBound(crr)
If crr(k) = "" Then Exit For
Next k
s = s & "," & j & "-" & k - 1
j = k
End If
Next j
arr(i, 3) = Mid(s, 2)
s = ""
Next i
[e2].Resize(UBound(arr), 3) = arr
End Sub

复制代码

robinaqiu · 发表于 2017-8-8 11:38

谢谢，版主，效率太高了，我会通过一个change事件来调用您的代码来实现对本行的数据进行剔除，希望您的代码加入一个可以输入的对话框，本行剔除的内容就是输入框中输入的内容

大灰狼1976 · 发表于 2017-8-8 12:00

你用change事件处理也可以的，可以输入的对话框就是inputbox，借用s1 = InputBox("Pls Input...")的处理方式就行。

robinaqiu · 发表于 2017-8-8 15:22

谢谢版主，这个若只剔除本行，而不是E2往下所有的单元格的话，需要怎么修改呢，我自己尝试了下修改，但太菜了对循环不懂，没能修改成功，能否再麻烦一下版主呢，谢谢

大灰狼1976 · 发表于 2017-8-8 15:50

给你一个附件。
说明，选中（不是编辑）A列某个单元格时，会跳出输入框，输入剔除数据（注意格式以,号或-号分隔规则不要变）后，B列会自动显示结果。

robinaqiu · 发表于 2017-8-8 17:24

非常感谢版主，附件就是想要实现的效果，单个数字左右没有相邻数字时候会出现N-N这种情况，例如1-10，剔除2,4，就会成为1-1,3-3,5-10这种情况，估计要把你的原始代码再好好研究下，回头研究不出来再请教版主哈，谢谢~

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