大神们，跪求个VB，按产量均分订单

qyfish

生产排计划，需按车间实际产能去排，然而每个订单的数量又都不一样，却必须一起生产
俺只会公式，可公式做不出来结果，求个VB，表格里有详细说明

谢谢大神们



已解决，23楼，正解，再次感谢大神 YZC51

qyfish

顶起，希望大神给看看

qyfish

顶起，希望大神给看看...

qyfish

顶起，哪位大神给看看...

Halloween张

右侧的结果你是怎么测试出来的啊

qyfish

Halloween张 发表于 2019-1-19 14:34
右侧的结果你是怎么测试出来的啊

纯手工计算提取的啊

Halloween张

qyfish 发表于 2019-1-19 15:04
纯手工计算提取的啊

手工计算是挺费脑子的

YZC51

想着给老师们鲜花吧！

一把小刀闯天下

Option Explicit

Const TM = 10 '跑10s随机数

Sub test()
  Dim arr, brr, crr, i, j, t, sum, dt, n, a, b, c, d, e, f, cnt
  arr = Range("b5:f" & Cells(Rows.Count, "b").End(xlUp).Row)
  brr = [b2:f2]
  Randomize
  dt = Timer
  ReDim sum(3 To UBound(arr, 2))
  d = 1: e = 1: f = 1
  Do
    For i = 1 To UBound(arr, 1)
      n = Int(Rnd * (UBound(arr, 1) - i + 1)) + i
      For j = 1 To UBound(arr, 2)
        t = arr(i, j): arr(i, j) = arr(n, j): arr(n, j) = t
        If j > 2 Then sum(j) = sum(j) + arr(i, j)
      Next
      a = Abs(sum(3) - brr(1, 3)) / brr(1, 3)
      b = Abs(sum(4) - brr(1, 4)) / brr(1, 4)
      c = Abs(sum(5) - brr(1, 5)) / brr(1, 5)
      If a < 0.05 And b < 0.05 And c < 0.05 Then
        If a < d And b < e And c < f Then
          d = a: e = b: f = c
          cnt = i: crr = arr:
          Debug.Print Timer - dt
        End If
      End If
    Next
    ReDim sum(3 To UBound(arr, 2))
    DoEvents
  Loop Until Timer - dt > TM
  If cnt = 0 Then MsgBox "!": Exit Sub
  With [l5]
    .Resize(Rows.Count - 4, UBound(crr, 2)).ClearContents
    .Resize(cnt, UBound(crr, 2)) = crr
  End With
End Sub

YZC51

一把小刀闯天下 发表于 2019-1-19 19:33
Option Explicit

Const TM = 10 '跑10s随机数

老师的思路太妙啦！