依訂單資料轉換成六週排程表，敬請各位大大賜教!!!

　頭銜: 麻辣路人甲

2012龍年全勤獎章熱烈參與勳章

1^# 跳轉到 »

發表於 2012-4-25 00:02 | 顯示全部帖子

回復 1# p6703

看不懂如何對應? 如何填入sheet2?
給個範例填入excel表內較易了解

　頭銜: 麻辣路人甲

2012龍年全勤獎章熱烈參與勳章

2^#

發表於 2012-4-25 18:12 | 顯示全部帖子

回復 4# p6703

程式語法不理想,尚有改進空間,請指正

Sub zz()
Set d = CreateObject("scripting.dictionary")
With Sheet1
ar = .Range("A2:F" & .[F2].End(xlDown).Row)
For i = 1 To UBound(ar)
x = ar(i, 1) & "," & ar(i, 2) & "," & ar(i, 3)
If Not d.exists(x) Then d.Add x, ar(i, 4) Else d(x) = d(x) + ar(i, 4)
Next i
End With
a = d.keys: b = d.items
c = 0
With Sheet2
.[A1].CurrentRegion.Offset(1, 0) = ""
For i = 0 To d.Count - 1
y = Split(a(i), ",")
.Range("A2").Offset(c, 0).Resize(1, 3) = y
.Range("D2").Offset(c, 0).Resize(2, 1) = Application.Transpose(Array("需求日", "交期"))
For j = 2 To Sheet1.[A2].End(xlDown).Row
x = Sheet1.Cells(j, 1) & "," & Sheet1.Cells(j, 2) & "," & Sheet1.Cells(j, 3)
If a(i) = x Then
E = Application.Match(Sheet1.Cells(j, 5), .Range(.[E1], .[E1].End(xlToRight)), 0)
.Range("E2").Offset(c, E - 1) = d(x)
F = Application.Match(Sheet1.Cells(j, 6), .Range(.[E1], .[E1].End(xlToRight)), 0)
.Range("E3").Offset(c, F - 1) = Sheet1.Cells(j, 4)
End If
Next j
c = c + 2
Next i
End With
End Sub

複製代碼

　頭銜: 麻辣路人甲

2012龍年全勤獎章熱烈參與勳章

3^#

發表於 2012-4-25 21:54 | 顯示全部帖子

回復 6# p6703

Book1.rar (9.82 KB)

靜思自在 : 得理要饒人，理直要氣和。