求助：自动填合适的交货日期

天干5424 · 发表于 2017-11-4 10:13

思路有了，看看怎么写
1.如果排程缺料中找不到需求，则值为暂不安排
2.如果本行是第一个采购订单，值等于第一个需求日期。
如查排程合计缺料少于最后一行采购订单的合计采购量，标记为已安排（加一列辅助）。否则为空，并停止循环。
3.如果本行需求等于第一个空白标记的缺料需求日期

sikaoge · 发表于 2017-11-4 13:28

本帖最后由 sikaoge 于 2017-11-4 22:10 编辑

supply_date.rar (196.45 KB, 下载次数: 5) 直接用excelq函数给你解决可以吗？一定要用代码吗
补充:
回来写了个函数,你看结果是不是你想要的

天干5424 · 发表于 2017-11-6 18:33

sikaoge 发表于 2017-11-4 13:28
直接用excelq函数给你解决可以吗？一定要用代码吗
补充:
回来写了个函数,你看结果是不是你想要的

高手!!正是我想要的！！

天干5424 · 发表于 2017-11-6 18:57

求分享一下代码。

sikaoge · 发表于 2017-11-11 16:40

本帖最后由 sikaoge 于 2017-11-11 23:51 编辑

天干5424 发表于 2017-11-6 18:57
求分享一下代码。

我今天回去发给你
Option Base 1
Function supplydate(rang1 As Range, rang2 As Range, Optional header As Boolean = True)
Dim dic1, dic2 As Object
Dim rng1, rng2 As Variant
Dim rng22() As Variant
Set dic1 = CreateObject("Scripting.dictionary")
Set dic2 = CreateObject("Scripting.dictionary")
If header = True Then
rng1 = rang1.Offset(1, 0).Resize(rang1.Rows.Count - 1, rang1.Columns.Count)
rng2 = rang2.Offset(1, 0).Resize(rang2.Rows.Count - 1, rang2.Columns.Count)
Else
rng1 = rang1
rng2 = rang2
End If

ReDim rng22(UBound(rng2))

For j = 1 To UBound(rng2)
For i = 1 To UBound(rng1)
      If rng2(j, 1) = rng1(i, 1) Then
         dic1(rng1(i, 1)) = dic1(rng1(i, 1)) + rng1(i, 2)
         If dic1(rng1(i, 1)) > dic2(rng2(j, 1)) Then
            rng22(j) = rng1(i, 3)

            Debug.Print dic1(rng1(i, 1))

            GoTo 100
         End If
      End If
Next i
100:
dic2(rng2(j, 1)) = dic2(rng2(j, 1)) + rng2(j, 2)
Debug.Print dic2(rng2(j, 1))
dic1.RemoveAll
Next j
supplydate = WorksheetFunction.Transpose(rng22)

End Function

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