求解月度商品销售数量

feiren228

香川群子 发表于 2018-7-17 17:28
还是先手动凑了一个结果：

先谢谢香川老师！
1.还有一种情况是预测均价高于计划均价
2.是否可以考虑调整商品销量的优先级，优先调整销量排名前十的商品？
3.是否可以根据预测均价与目标值的差价，优先调整差价接近的几种商品？
4.是否需要考虑调增或者调减的step步进值？

香川群子

feiren228 发表于 2018-7-17 17:51
先谢谢香川老师！
1.还有一种情况是预测均价高于计划均价
2.是否可以考虑调整商品销量的优先级，优先调整 ...

第1点，根据价差正负不同，调整对象不同，这个是自然的事。

第2点，根据优先级调整可以做，但需要你自己确定优先级对象和调整幅度范围，也比较麻烦。
目前是不分优先级，按比例调整。

第3点意义不大。价差越是接近，调整效果就越小。

第4点无所谓。

feiren228

香川群子 发表于 2018-7-18 08:23
第1点，根据价差正负不同，调整对象不同，这个是自然的事。

第2点，根据优先级调整可以做，但需要你自 ...

好的，谢谢先

一把小刀闯天下

test.rar (18.38 KB, 下载次数: 6)

2018-7-18 14:34 上传

点击文件名下载附件

'数量随机数间隔分布不太好，不过效率还算可以的

'品5"、"品8"放最后了，为了计算方便

Option Explicit

Sub test()
  Dim arr, i, j, cnt, total As Single, pri_ave As Single, n, pri_sum, m, t As Single, num
  arr = [a4:c20]
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) <> "品5" And arr(i, 1) <> "品8" Then
      n = n + 1
      For j = 1 To UBound(arr, 2): brr(n, j) = arr(i, j): Next
      pri_sum = pri_sum + arr(i, 2)
    Else
      cnt = cnt + arr(i, 3)
      total = total + arr(i, 2) * arr(i, 3)
    End If
  Next
  cnt = arr(UBound(arr, 1), 3) - cnt
  total = arr(UBound(arr, 1), 2) * arr(UBound(arr, 1), 3) - total
  pri_ave = Round(total / cnt, 0)
  Randomize
  Do
    t = 0: num = 0
    For i = 1 To n
      m = Round(total / n / arr(i, 2) * (0.8 + Rnd / 5) * arr(i, 2) / pri_ave, 1)
      brr(i, 3) = m: num = num + m
      t = t + brr(i, 2) * m
    Next
    num = Round(cnt - num, 1)
    t = Round(total - t, 1)
    If t > 0 And num > 0 Then
      For i = 1 To n
        If num * brr(i, 2) = t Then brr(i, 3) = brr(i, 3) + num: Exit Do
      Next
    End If
    DoEvents
  Loop
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) = "品5" Or arr(i, 1) = "品8" Then
      n = n + 1
      brr(n, 1) = arr(i, 1): brr(n, 2) = arr(i, 2): brr(n, 3) = arr(i, 3)
    End If
  Next
  [e4].Resize(n, UBound(arr, 2)) = brr
End Sub

feiren228

一把小刀闯天下 发表于 2018-7-18 14:34
'数量随机数间隔分布不太好，不过效率还算可以的

'品5"、"品8"放最后了，为了计算方便

谢谢，附件更新了，能根据预测量进行调整吗？

一把小刀闯天下

feiren228 发表于 2018-7-18 15:21
谢谢，附件更新了，能根据预测量进行调整吗？

副本test.rar (18.14 KB, 下载次数: 5)

2018-7-18 19:39 上传

点击文件名下载附件

'品5、品8离目标值太大，其他值离目标值过大。调整计算公式还是相差较大

Option Explicit

Sub test()
  Dim arr, i, j, cnt, total As Single, n, m, t As Single, num
  arr = [a4:g20]
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) <> "品5" And arr(i, 1) <> "品8" Then
      n = n + 1
      For j = 1 To UBound(arr, 2): brr(n, j) = arr(i, j): Next
    Else
      cnt = cnt + arr(i, 6)
      total = total + arr(i, 2) * arr(i, 6)
    End If
  Next
  cnt = [b2].Value - cnt
  total = [d2].Value * [b2].Value - total
  Randomize
  Do
    t = 0: num = 0
    For i = 1 To n
      m = Round(brr(i, 3) * cnt * (0.9 + Rnd / 5), 1) '目标值的90%-110% 自己调整
      brr(i, 6) = m: num = num + m
      t = t + brr(i, 2) * m
    Next
    num = Round(cnt - num, 1)
    t = Round(total - t, 1)
    If t > 0 And num > 0 Then
      For i = 1 To n
        If num * brr(i, 2) = t Then brr(i, 6) = brr(i, 6) + num: Exit Do
      Next
    End If
    DoEvents
  Loop
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) = "品5" Or arr(i, 1) = "品8" Then
      n = n + 1
      For j = 1 To UBound(brr, 2)
        brr(n, j) = arr(i, j)
      Next
    End If
    brr(i, 7) = brr(i, 2) * brr(i, 6)
  Next
  [a23].Resize(n, UBound(arr, 2)) = brr
End Sub