关于生成装箱数据的问题

netdf · 发表于 2019-3-21 16:33

求各位大神帮我看下，能不能有啥办法自动生成装箱数据。感谢。。。。

lizi12000 · 发表于 2019-3-21 16:43

学习一下。。。

netdf · 发表于 2019-3-22 08:15

大神们，你们在哪呢？

ykqrs · 发表于 2019-3-22 09:24

Sub qq()
Dim arr, brr(1 To 1000, 1 To 4), i%, j%, r%, n%, m%
arr = [a2].CurrentRegion
For i = 2 To UBound(arr)
If arr(i, 2) > arr(i, 3) Then
n = arr(i, 3): j = Application.RoundUp(arr(i, 2) / arr(i, 3), 0)
r = 1
Do
m = m + 1
brr(m, 1) = arr(i, 1)
brr(m, 2) = r
brr(m, 3) = j
brr(m, 4) = n
arr(i, 2) = arr(i, 2) - n
n = IIf(n <= arr(i, 2), n, arr(i, 2))
r = r + 1
Loop While arr(i, 2) > 0
Else
m = m + 1
brr(m, 1) = arr(i, 1)
brr(m, 2) = 1
brr(m, 3) = 1
brr(m, 4) = arr(i, 2)
End If
Next
[h1].CurrentRegion.Offset(1).ClearContents
[h2].Resize(m, 4) = brr
End Sub

复制代码

ykqrs · 发表于 2019-3-22 09:27

vba求助.rar (22.35 KB, 下载次数: 11)

小花鹿 · 发表于 2019-3-22 09:38

Sub test()
Dim ar, br(1 To 65536, 1 To 4), i&, j&, r&, n&, n1&
ar = [a1].CurrentRegion
For i = 2 To UBound(ar)
n1 = 0
n = Application.RoundUp(ar(i, 2) / ar(i, 3), 0)
For j = 1 To n
      r = r + 1
      n1 = n1 + 1
      br(r, 1) = ar(i, 1)
      br(r, 2) = n1
      br(r, 3) = n
      If j = n Then
         br(r, 4) = ar(i, 2)
      Else
         br(r, 4) = ar(i, 3)
      End If
      ar(i, 2) = ar(i, 2) - ar(i, 3)
Next j
Next i
[l2].Resize(r, 4) = br
End Sub

一把小刀闯天下 · 发表于 2019-3-22 09:47

Option Explicit

Sub test()
  Dim arr, i, j, n, m, a, b, brr(1 To 10 ^ 4, 1 To 4)
  arr = [a1].CurrentRegion
  For i = 2 To UBound(arr, 1)
a = arr(i, 2) Mod arr(i, 3): b = 0
n = arr(i, 2) \ arr(i, 3) + IIf(a > 0, 1, 0)
For j = 1 To n
   m = m + 1: b = b + 1
   brr(m, 1) = arr(i, 1): brr(m, 2) = b: brr(m, 3) = n
   brr(m, 4) = IIf(arr(i, 2) >= arr(i, 3), arr(i, 3), a)
   arr(i, 2) = arr(i, 2) - arr(i, 3)
  Next j, i
  With [h2]
.Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
.Resize(m, UBound(brr, 2)) = brr
  End With
End Sub

netdf · 发表于 2019-3-23 09:20

谢谢楼上的各位大神，效果非常好。感谢。。。。

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

[求助] 关于生成装箱数据的问题

评分

评分