ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 427|回复: 4

[求助] 如何写代码实现按照回仓数据按照下单数据分配

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-3-14 15:46 | 显示全部楼层 |阅读模式
问题请教.zip (8.96 KB, 下载次数: 5)
详细问题在附件,麻烦帮忙解决。谢谢!

TA的精华主题

TA的得分主题

发表于 2019-3-14 16:07 | 显示全部楼层
问题看不太明白
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-3-14 16:18 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-14 16:26 | 显示全部楼层
朱荣兴 发表于 2019-3-14 16:18
看不明白你的需求,比如:下单比例是指什么

就是每人下单的数量除以下单的合计数。

TA的精华主题

TA的得分主题

发表于 2019-3-16 15:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. Option Explicit
  2. Private Sub ReDistribution()
  3. Dim aData, aResult, aOutPut()
  4. Dim nSum&, nMax&, nMin&, nMaxCol&, nMinCol&
  5. Dim nGap&
  6. Dim i&, j&
  7. aData = [A1].CurrentRegion.Value
  8. aResult = [I1].Resize(UBound(aData, 1), 1).Value
  9. aOutPut = [I1].Resize(UBound(aData, 1), 8).Value
  10. For i = 2 To UBound(aData, 1)
  11.     nSum = 0: nMax = 0: nMin = 0
  12.     For j = 3 To 7
  13.         aOutPut(i, j) = Round(aResult(i, 1) * aData(i, j) / aData(i, 2), 0)
  14.         nSum = nSum + aOutPut(i, j)
  15.         If aOutPut(i, j) > nMax Then
  16.             nMax = aOutPut(i, j): nMaxCol = j
  17.         End If
  18.         If nMin = 0 Then
  19.             nMin = aOutPut(i, j): nMinCol = j
  20.         ElseIf aOutPut(i, j) < nMin Then
  21.             nMin = aOutPut(i, j): nMinCol = j
  22.         End If
  23.     Next
  24.     If nSum > aResult(i, 1) Then
  25.         nGap = nSum - aResult(i, 1)
  26.         aOutPut(i, nMaxCol) = aOutPut(i, nMaxCol) - nGap
  27.         aOutPut(i, 8) = nSum - nGap
  28.     ElseIf nSum < aResult(i, 1) Then
  29.         nGap = aResult(i, 1) - nSum
  30.         aOutPut(i, nMinCol) = aOutPut(i, nMinCol) + nGap
  31.         aOutPut(i, 8) = nSum + nGap
  32.     End If
  33. Next
  34. [I1].Resize(UBound(aData, 1), 8).Value = aOutPut
  35. End Sub
复制代码

按实重新分配.rar

15.08 KB, 下载次数: 6

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 21:59 , Processed in 0.043788 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表