求助大神用VBA解决难题

遨游in_sky · 发表于 2015-11-20 01:01

已知工件编号和对应工件编号的长度，想要尽可能多的匹配一定范围长度的两拼工件，匹配过的工件不可在使用，求解！！！详见附件！

遨游in_sky · 发表于 2015-11-21 08:51

过路的大神住下脚，急助下小弟不胜感激！！！

yaozong · 发表于 2015-11-21 12:40

遨游in_sky 发表于 2015-11-21 08:51
过路的大神住下脚，急助下小弟不胜感激！！！

Sub yy()
Dim arr, a, b, i, j, k, m, n, y
arr = [a1].CurrentRegion
y = UBound(arr)
[p1].Resize(y, 2) = arr
[p2].Resize(y - 1, 2).Sort [q2], 1
arr = [p1].CurrentRegion
[p1].CurrentRegion = ""
a = 600
b = 650
ReDim brr(1 To y, 1 To 6)
For i = y To 3 Step -1
  For j = 2 To y
If arr(i, 2) + arr(j, 2) >= a And arr(i, 2) + arr(j, 2) <= b Then
   m = m + 1
   brr(m, 1) = m
   brr(m, 2) = arr(i, 1)
   brr(m, 3) = arr(i, 2)
   brr(m, 4) = arr(j, 1)
   brr(m, 5) = arr(j, 2)
   brr(m, 6) = brr(m, 3) + brr(m, 5)
   arr(i, 2) = 0
   arr(j, 2) = 0
End If
  Next
Next
For i = 2 To y
  If arr(i, 2) <> 0 Then
   n = n + 1
   arr(n, 1) = arr(i, 1)
   arr(n, 2) = arr(i, 2)
  End If
Next
[f3:n100] = ""
[F3].Resize(m, 6) = brr
[m3].Resize(n, 2) = arr
End Sub

yaozong · 发表于 2015-11-21 12:42

附件

151121-凑数.rar (21.74 KB, 下载次数: 12)

遨游in_sky · 发表于 2015-11-21 12:56

大神，您真是大神啊！
五体投地的佩服了！
谢谢！！！

遨游in_sky · 发表于 2015-11-21 13:31

yaozong 发表于 2015-11-21 12:42
附件

大神，再请教下：如果两拼的结束后能否再加个把剩余的进行一次三拼的计算？

遨游in_sky · 发表于 2015-11-23 08:29

大神，再请教下：如果两拼的结束后能否再加个把剩余的进行一次三拼的计算？

yaozong · 发表于 2015-11-23 11:28

遨游in_sky 发表于 2015-11-23 08:29
大神，再请教下：如果两拼的结束后能否再加个把剩余的进行一次三拼的计算？

151121-凑数2.rar (26.87 KB, 下载次数: 13) 参考附件

遨游in_sky · 发表于 2015-11-23 19:18

本帖最后由遨游in_sky 于 2015-11-23 19:41 编辑

yaozong 发表于 2015-11-23 11:28
参考附件

谢谢大神,我把数据换了一组，三拼里出现重复的数据了，烦请您再给看看！

yaozong · 发表于 2015-11-24 09:19

遨游in_sky 发表于 2015-11-23 19:18
谢谢大神,我把数据换了一组，三拼里出现重复的数据了，烦请您再给看看！

151121-凑数2.zip (47.13 KB, 下载次数: 20)

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