ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 资深财务总监教您玩转Excel 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 13门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 91|回复: 7
打印 上一主题 下一主题

[求助] 求大神帮忙看一下生产计划排产的能否用VBA解决同一工单放在两条线.3条线上面生产的...

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2018-4-17 19:15 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
如题、
求大神帮忙看一下生产计划排产的能否用VBA解决同一工单放在两条线.3条线上面生产的情况
例如,产品型号,生产批次一样的情况下,用附件大神的代码只会排第一个。
需要用VBA解决:当 产品型号,生产批次一样时,   线体不同的情况下, VBA能否将未完成数量平均除线体数排下去,
例如一个生产订单是28000  ,已完成4000,   未完成24000,
2条线排的情况下,每条线排12000,
3条线排的情况下,每条线排  未完成数量/线体数
以此类推。 请大神帮忙看看! 上传附件  是1线,3线,5线在打B面。这样排不下去。






微信图片.png (90.23 KB, 下载次数: 0) 排程
排程
排产4-17 - 副本.rar 20.04 KB, 下载次数: 2 排产计划
TA的精华主题TA的得分主题
2
 楼主| 发表于 2018-4-17 19:19 | 只看该作者
代码如下:
Dim planQty As Double    '计划数量
Dim calcQty As Double    '已排产数量
Dim diffQty As Double    '差异
Dim machQty As Double    '小时产能
Dim orderQty As Double   '订单数量
Dim stockQty As Double   '订单差异
Dim surplusTime As Double '剩余时间
Dim orderSum As Double      '订单合计
Dim beginRow As Integer   '开始行
Dim beginCol As Integer   '开始列
Dim beginCols As String
Dim endRow As Integer     '结束行
Dim endCol As Integer     '结束列
Dim planDate As Date      '计划日期
Dim orderDate As Date     '订单日期

Sub calc()
    Dim currRow As Integer '计算用的当前行
    Dim currCol As Integer '计算用的当前列
    Dim flag As Integer
    'Range("K6") = Range("K1")   在表中定义
    beginRow = Cells(1, 2)
    beginCol = Cells(2, 2)
    beginCols = Cells(2, 3)
    endCol = Range("iv2").End(xlToLeft).Column '至班次最后一格(第二行,横向)
    endRow = Range("C65536").End(xlUp).row     '至产线最后一行(E行,竖向)
   
    Range(beginCols & beginRow & ":iv" & endRow).ClearContents                 '清除原计划数量
    Range("A" & beginRow & ":iv65536").Interior.ColorIndex = xlNone            '清除所有背景色
    Range("A" & beginRow & ":A" & endRow).ClearContents                        '清除原交期
    Range(beginCols & "3:iv3").ClearContents                                   '清除当天已用工作时间
    Range("I" & beginRow & ":I" & endRow).ClearContents                        '清除已排产数量
    flag = 1
    For currRow = beginRow To endRow  '第一层循环:  每一行
        calcQty = 0
        If Cells(currRow, 3) <> Cells(currRow - 1, 3) Then                     '与上一行线号是否相同
            Range(beginCols & "3:iv3").ClearContents                           '清除当天已用工作时间
            flag = flag * -1
        End If
        If flag > 0 Then
            Range("A" & currRow & ":K" & currRow).Interior.ColorIndex = 24
        Else
            Range("A" & currRow & ":K" & currRow).Interior.ColorIndex = 34
        End If
            
        For currCol = beginCol To endCol  '第二层循环: 每一列
            surplusTime = Cells(4, currCol)    '剩余时间
            If surplusTime > 0 Then            '当天有剩余时间,才安排计划
                orderQty = Cells(currRow, 7)   '订单数量
                stockQty = Cells(currRow, 8)   '已完成数量
                orderSum = Cells(currRow, 11)
               
                If orderSum < 0 Then
                    calcQty = Int(CheckCalcqty(currRow, Cells(currRow, 6), Cells(currRow, 5)))
                    Cells(currRow, 9) = calcQty                                           '已排产数量
                    diffQty = orderQty - stockQty - calcQty                               '差异
                    '差异大于0,即还有未完成的订单数量
                    If diffQty > 0 Then
                        machQty = Cells(currRow, 10)    '小时产能
                        planQty = surplusTime * machQty    '计划数量
                        planDate = Cells(beginRow - 2, currCol)
                        orderDate = Cells(currRow, 2)
                        If ((Len(Cells(currRow, 2)) = 0) Or (planDate < orderDate)) Then   '订单日期为空,或者计划日期小于订单日期
                            If planQty > diffQty Then
                                Cells(currRow, currCol) = diffQty                          '计划数大于差异数,就用差异数排产
                                Cells(currRow, currCol).Interior.ColorIndex = 3            '当前计划不饱和用红色
                                Cells(3, currCol) = Cells(3, currCol) + diffQty / machQty
                            Else
                                Cells(currRow, currCol) = planQty
                                Cells(currRow, currCol).Interior.ColorIndex = 6            '当前计划饱和用黄色
                                Cells(3, currCol) = Cells(3, currCol) + planQty / machQty
                            End If
                            Cells(currRow, 1) = Cells(beginRow - 2, currCol)    '预计交期
                            calcQty = calcQty + Cells(currRow, currCol)         '已排产数量+当前排产数
                        Else         '计划日期大于订单日期,超期不要排计划
                           Exit For
                        End If
                    Else                   '订单数-已完成-已排产<=0
                        Exit For
                    End If
                    Cells(currRow, 9) = calcQty               '已排产数量
                Else
                    Exit For
                End If
            End If
        Next
        '将已排产数量回写到相同订单中
        For i = beginRow To currRow - 1
            If ((Cells(i, 5) = Cells(currRow, 5)) And (Cells(i, 6) = Cells(currRow, 6))) Then
                Cells(i, 9) = calcQty
            End If
        Next
        Application.Calculate '有公式的地方计算一下
    Next
   


End Sub
'检查已排产数量
Function CheckCalcqty(ByVal row As Integer, lot As String, spec As String)
    Dim i As Integer
    Dim j As Integer
    Dim lot2 As String   '用来比较的批号(订单号)
    Dim spec2 As String   '用来比较的型号(因为SMT有的产品有两面,即订单号相同,订单号不能作唯一识别)
    Dim qty As Double
   
    qty = 0
    For i = beginRow To row    '从第一行循环到当前行,计算相同订单已排产数量
        lot2 = Cells(i, 6)
        spec2 = Cells(i, 5)
        If ((lot = lot2) And (spec = spec2)) Then
            For j = beginCol To endCol
                qty = qty + Cells(i, j)   '已排的计划数
            Next
        End If
    Next
    CheckCalcqty = qty
End Function
TA的精华主题TA的得分主题
3
 楼主| 发表于 2018-4-17 19:28 | 只看该作者
TA的精华主题TA的得分主题
4
 楼主| 发表于 2018-4-17 20:18 | 只看该作者
TA的精华主题TA的得分主题
5
 楼主| 发表于 2018-4-17 23:27 来自手机 | 只看该作者
TA的精华主题TA的得分主题
6
发表于 2018-4-18 06:02 来自手机 | 只看该作者
TA的精华主题TA的得分主题
7
 楼主| 发表于 2018-4-20 08:10 | 只看该作者
TA的精华主题TA的得分主题
8
 楼主| 发表于 2018-4-20 08:14 | 只看该作者
您需要登录后才可以回帖 登录 | 免费注册
本版积分规则
关闭

最新热点上一条 /1 下一条

关注官方微信,每天学会一个新技能
手机版|关于我们|联系我们|ExcelHome GMT+8, 2018-4-25 00:16 , Processed in 0.064521 second(s), 12 queries , Gzip On, MemCache On.
Powered by Discuz! X3.4 © 2001-2017 Wooffice Inc.
    沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
快速回复 返回顶部 返回列表
99uu优优