(非常感谢：蓝桥玄霜 老師 已解决!) 多項式條件而綜合的簡報表，臺灣討論區也沒法幫我

tommyszeto

中午好 蓝桥玄霜老師
您多麼快的回覆,  Thank you so much for your help and assistance.

但剛發覺計算時有少許誤會, =IF(G11>=H11,"On-time",IF(H11-G11<=14,"Delay 1","Delay 2"))

因此我要厚著臉皮再一找你幫幫忙,不好意思~ 希望你能夠見諒!

設資料在G11欄是:RTA (date)
設資料在H11欄是:PC confirmed ETA (date)

1. On-time=(H11)是不超越(G11)當天或之前
2. Delay 1=(H11)已超越(G11)在之後的14天內
3. Delay 2=(H11)已超越(G11)14天之後


此外, 可以俢改為結束後存放的指定工作頁名稱是NTG, 否則msgbox顯示 NO NTG WORKSHEET。可以嗎?

tommyszeto

untitled.zip (14.62 KB, 下载次数: 14)

2010-3-23 18:05 上传

点击文件名下载附件

上載附件, 請幫幫忙!

蓝桥玄霜

1. Sub tj()
   
2. Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da, a12, jj&
   
3. Dim d, k, t, d1, k1, t1, aa, bb, k11, k22
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set d1 = CreateObject("Scripting.Dictionary")
   
6. Myr = Sheet1.[c65536].End(xlUp).Row
   
7. Arr = Sheet1.Range("a5:aa" & Myr)
   
8. For i = 1 To UBound(Arr)
   
9.     x = Arr(i, 3) & "|" & Arr(i, 5) & "|" & Arr(i, 13) & "|" & Arr(i, 15) & "|" & Arr(i, 16) & "|" & Arr(i, 25) & "|" & Arr(i, 26)
   
10.     d(x) = d(x) + Arr(i, 11)
    
11.     d1(x) = d1(x) & i & ","
    
12. Next
    
13. ReDim Arr1(1 To d.Count, 1 To 13)
    
14. k = d.keys
    
15. t = d.items
    
16. t1 = d1.items
    
17. d.RemoveAll
    
18. d1.RemoveAll
    
19. For i = 0 To UBound(k)
    
20.     da = #12/31/2009#
    
21.     aa = Split(k(i), "|")
    
22.     Arr1(i + 1, 1) = aa(0)
    
23.     Arr1(i + 1, 2) = aa(2)
    
24.     Arr1(i + 1, 3) = aa(3)
    
25.     Arr1(i + 1, 4) = aa(4)
    
26.     Arr1(i + 1, 7) = aa(6)
    
27.     Arr1(i + 1, 9) = aa(5)
    
28.     Arr1(i + 1, 10) = t(i)
    
29.     b = Left(t1(i), Len(t1(i)) - 1)
    
30.     If InStr(b, ",") > 0 Then
    
31.         bb = Split(b, ",")
    
32.         For j = 0 To UBound(bb)
    
33.             If aa(1) = "3RD PARTY" Then
    
34.                 Arr1(i + 1, 12) = Arr1(i + 1, 12) & Arr(bb(j), 4) & "/"
    
35.             Else
    
36.                 Arr1(i + 1, 12) = aa(1)
    
37.             End If
    
38.             d(Arr(bb(j), 22)) = ""
    
39.             d1(Arr(bb(j), 23)) = ""
    
40.         Next
    
41.         For j = 0 To UBound(bb)
    
42.             If Arr(bb(j), 27) = "TBA" Then
    
43.                 Arr1(i + 1, 8) = "TBA": Exit For
    
44.             ElseIf Arr(bb(j), 27) = "NO ETD" Then
    
45.                 Arr1(i + 1, 8) = "NO ETD": Exit For
    
46.             Else
    
47.                 If Arr(bb(j), 27) > da Then
    
48.                     da = Arr(bb(j), 27)
    
49.                 End If
    
50.                 Arr1(i + 1, 8) = da
    
51.             End If
    
52.         Next
    
53.         If Arr1(i + 1, 8) <> "TBA" And Arr1(i + 1, 8) <> "NO ETD" Then
    
54.             Arr1(i + 1, 8) = Arr1(i + 1, 8)
    
55.         End If
    
56.         k11 = d.keys
    
57.         k22 = d1.keys
    
58.         For ii = 0 To UBound(k11)
    
59.             Arr1(i + 1, 5) = Arr1(i + 1, 5) & "WK" & k11(ii) & "/"
    
60.         Next
    
61.         For ii = 0 To UBound(k22)
    
62.             Arr1(i + 1, 6) = Arr1(i + 1, 6) & k22(ii) & "/"
    
63.         Next
    
64.         If InStr(Arr1(i + 1, 5), "/") > 0 Then
    
65.             Arr1(i + 1, 5) = Left(Arr1(i + 1, 5), Len(Arr1(i + 1, 5)) - 1)
    
66.         End If
    
67.         If InStr(Arr1(i + 1, 6), "/") > 0 Then
    
68.             Arr1(i + 1, 6) = Left(Arr1(i + 1, 6), Len(Arr1(i + 1, 6)) - 1)
    
69.         End If
    
70.         d.RemoveAll
    
71.         If InStr(Arr1(i + 1, 12), "/") > 0 Then
    
72.             Arr1(i + 1, 12) = Left(Arr1(i + 1, 12), Len(Arr1(i + 1, 12)) - 1)
    
73.             a12 = Split(Arr1(i + 1, 12), "/")
    
74.             For jj = 0 To UBound(a12)
    
75.                 d(a12(jj)) = ""
    
76.             Next
    
77.             Arr1(i + 1, 12) = Join(d.keys, "/")
    
78.         End If
    
79.     Else
    
80.         Arr1(i + 1, 12) = Arr(Val(b), 4)
    
81.         Arr1(i + 1, 5) = "WK" & Arr(Val(b), 22)
    
82.         Arr1(i + 1, 6) = Arr(Val(b), 23)
    
83.         Arr1(i + 1, 8) = Arr(Val(b), 27)
    
84.     End If
    
85.     d.RemoveAll
    
86.     d1.RemoveAll
    
87.     If Arr1(i + 1, 8) = "" Then
    
88.         Arr1(i + 1, 11) = "No Claddified"
    
89.     ElseIf Arr1(i + 1, 8) = "NO ETD" Then
    
90.         Arr1(i + 1, 11) = "No planned ETD"
    
91.     ElseIf Arr1(i + 1, 8) = "TBA" Then
    
92.         Arr1(i + 1, 11) = "PC can't provide planned ETD per schedule, assume they are late"
    
93.     ElseIf CDate(Arr1(i + 1, 7)) >= CDate(Arr1(i + 1, 8)) Then
    
94.         Arr1(i + 1, 11) = "On-time"
    
95.     ElseIf CDate(Arr1(i + 1, 8)) - CDate(Arr1(i + 1, 7)) <= 14 Then
    
96.         Arr1(i + 1, 11) = "Delay 1"
    
97.     Else
    
98.         Arr1(i + 1, 11) = "Delay 2"
    
99.     End If
    
100.     If Arr1(i + 1, 11) = "Delay 2" Or Arr1(i + 1, 11) = "Delay 1" Or Arr1(i + 1, 8) = "TBA" Then
     
101.         Arr1(i + 1, 13) = "RED"
     
102.     ElseIf Arr1(i + 1, 11) = "On-time" Then
     
103.         Arr1(i + 1, 13) = "GREEN"
     
104.     ElseIf Arr1(i + 1, 8) = "NO ETD" Then
     
105.         Arr1(i + 1, 13) = "WHITE"
     
106.     Else
     
107.         Arr1(i + 1, 13) = ""
     
108.     End If
     
109. Next
     
110. Sheet2.Activate
     
111. [a11:m1000].ClearContents
     
112. [a11].Resize(UBound(Arr1), 13) = Arr1
     
113. Set d = Nothing
     
114. Set d1 = Nothing
     
115. 
     
116. End Sub
     

复制代码

tommyszeto

原帖由 蓝桥玄霜 于 2010-3-24 11:16 发表
Sub tj()
Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da, a12, jj&
Dim d, k, t, d1, k1, t1, aa, bb, k11, k22
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
...

正呀! 搞掂了! 多謝你對我的不離不棄。

tommyszeto

原帖由藍橋玄霜 於2010-3-24 11:16 發表
Sub tj()
Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da, a12, jj&
Dim d, k, t, d1, k1, t1, aa, bb, k11, k22
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
&nbsp;...

您好 藍橋玄霜老師:

我又遇上了重大的問題啊~
- 正確的日期不能對應
- ctr2 除了3RD PARTY之外, 其他就不能集中往同一資料格內,並以/ , eg AAA/BBB
help me.zip (23.91 KB, 下载次数: 13)

2010-4-24 23:47 上传

点击文件名下载附件

請幫忙!

[ 本帖最后由 tommyszeto 于 2010-4-24 23:52 编辑 ]

蓝桥玄霜

1. Private Sub CommandButton1_Click()
   
2. Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da, a12, jj&
   
3. Dim d, k, t, d1, k1, t1, aa, bb, k11, k22, ctr$
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set d1 = CreateObject("Scripting.Dictionary")
   
6. Myr = Sheet1.[c65536].End(xlUp).Row
   
7. Arr = Sheet1.Range("a5:aa" & Myr)
   
8. For i = 1 To UBound(Arr)
   
9. x = Arr(i, 3) & "|" & Arr(i, 5) & "|" & Arr(i, 13) & "|" & Arr(i, 15) & "|" & Arr(i, 16) & "|" & Arr(i, 25) & "|" & Arr(i, 26)
   
10.     d(x) = d(x) + Arr(i, 11)
    
11.     d1(x) = d1(x) & i & ","
    
12. Next
    
13. ReDim Arr1(1 To d.Count, 1 To 13)
    
14. k = d.keys
    
15. t = d.items
    
16. t1 = d1.items
    
17. d.RemoveAll
    
18. d1.RemoveAll
    
19. For i = 0 To UBound(k)
    
20.     da = #12/31/2009#: ctr = ""
    
21.     aa = Split(k(i), "|")
    
22.     Arr1(i + 1, 1) = aa(0)
    
23.     Arr1(i + 1, 2) = aa(2)
    
24.     Arr1(i + 1, 3) = aa(3)
    
25.     Arr1(i + 1, 4) = aa(4)
    
26.     Arr1(i + 1, 7) = DateValue(aa(6))
    
27.     Arr1(i + 1, 9) = aa(5)
    
28.     Arr1(i + 1, 10) = t(i)
    
29.     b = Left(t1(i), Len(t1(i)) - 1)
    
30.     If InStr(b, ",") > 0 Then
    
31.         bb = Split(b, ",")
    
32.         For j = 0 To UBound(bb)
    
33.             If aa(1) = "3RD PARTY" Then
    
34.                 ctr = ctr & Arr(bb(j), 4) & "/"
    
35.             Else
    
36.                 If InStr(ctr, Arr(bb(j), 4)) = 0 Then
    
37.                     ctr = ctr & Arr(bb(j), 4) & "/"
    
38.                 End If
    
39.             End If
    
40.             d(Arr(bb(j), 22)) = ""
    
41.             d1(Arr(bb(j), 23)) = ""
    
42.         Next
    
43.         If Len(ctr) - Len(Replace(ctr, "/", "")) > 1 Then
    
44.             Arr1(i + 1, 12) = ctr
    
45.         Else
    
46.             Arr1(i + 1, 12) = aa(1)
    
47.         End If
    
48.         For j = 0 To UBound(bb)
    
49.             If Arr(bb(j), 27) = "TBA" Then
    
50.                 Arr1(i + 1, 8) = "TBA": Exit For
    
51.             ElseIf Arr(bb(j), 27) = "NO ETD" Then
    
52.                 Arr1(i + 1, 8) = "NO ETD": Exit For
    
53.             Else
    
54.                 If Arr(bb(j), 27) > da Then
    
55.                     da = Arr(bb(j), 27)
    
56.                 End If
    
57.                 Arr1(i + 1, 8) = da
    
58.             End If
    
59.         Next
    
60.         If Arr1(i + 1, 8) <> "TBA" And Arr1(i + 1, 8) <> "NO ETD" Then
    
61.             Arr1(i + 1, 8) = Arr1(i + 1, 8)
    
62.         End If
    
63.         k11 = d.keys
    
64.         k22 = d1.keys
    
65.         For ii = 0 To UBound(k11)
    
66.             Arr1(i + 1, 5) = Arr1(i + 1, 5) & "WK" & k11(ii) & "/"
    
67.         Next
    
68.         For ii = 0 To UBound(k22)
    
69.             Arr1(i + 1, 6) = Arr1(i + 1, 6) & k22(ii) & "/"
    
70.         Next
    
71.         If InStr(Arr1(i + 1, 5), "/") > 0 Then
    
72.             Arr1(i + 1, 5) = Left(Arr1(i + 1, 5), Len(Arr1(i + 1, 5)) - 1)
    
73.         End If
    
74.         If InStr(Arr1(i + 1, 6), "/") > 0 Then
    
75.             Arr1(i + 1, 6) = Left(Arr1(i + 1, 6), Len(Arr1(i + 1, 6)) - 1)
    
76.         End If
    
77.         d.RemoveAll
    
78.         If InStr(Arr1(i + 1, 12), "/") > 0 Then
    
79.             Arr1(i + 1, 12) = Left(Arr1(i + 1, 12), Len(Arr1(i + 1, 12)) - 1)
    
80.             a12 = Split(Arr1(i + 1, 12), "/")
    
81.             For jj = 0 To UBound(a12)
    
82.                 d(a12(jj)) = ""
    
83.             Next
    
84.             Arr1(i + 1, 12) = Join(d.keys, "/")
    
85.         End If
    
86.     Else
    
87.         Arr1(i + 1, 12) = Arr(Val(b), 4)
    
88.         Arr1(i + 1, 5) = "WK" & Arr(Val(b), 22)
    
89.         Arr1(i + 1, 6) = Arr(Val(b), 23)
    
90.         Arr1(i + 1, 8) = Arr(Val(b), 27)
    
91.     End If
    
92.     d.RemoveAll
    
93.     d1.RemoveAll
    
94.     If Arr1(i + 1, 8) = "" Then
    
95.         Arr1(i + 1, 11) = "No Claddified"
    
96.     ElseIf Arr1(i + 1, 8) = "NO ETD" Then
    
97.         Arr1(i + 1, 11) = "No planned ETD"
    
98.     ElseIf Arr1(i + 1, 8) = "TBA" Then
    
99.         Arr1(i + 1, 11) = "PC can't provide planned ETD per schedule, assume they are late"
    
100.     ElseIf CDate(Arr1(i + 1, 7)) >= CDate(Arr1(i + 1, 8)) Then
     
101.         Arr1(i + 1, 11) = "On-time"
     
102.     ElseIf CDate(Arr1(i + 1, 8)) - CDate(Arr1(i + 1, 7)) <= 14 Then
     
103.         Arr1(i + 1, 11) = "Delay 1"
     
104.     Else
     
105.         Arr1(i + 1, 11) = "Delay 2"
     
106.     End If
     
107.     If Arr1(i + 1, 11) = "Delay 2" Or Arr1(i + 1, 11) = "Delay 1" Or Arr1(i + 1, 8) = "TBA" Then
     
108.         Arr1(i + 1, 13) = "RED"
     
109.     ElseIf Arr1(i + 1, 11) = "On-time" Then
     
110.         Arr1(i + 1, 13) = "GREEN"
     
111.     ElseIf Arr1(i + 1, 8) = "NO ETD" Then
     
112.         Arr1(i + 1, 13) = "WHITE"
     
113.     Else
     
114.         Arr1(i + 1, 13) = ""
     
115.     End If
     
116. Next
     
117. Sheet2.Activate
     
118. [a11:m1000].ClearContents
     
119. [a11].Resize(UBound(Arr1), 13) = Arr1
     
120. Set d = Nothing
     
121. Set d1 = Nothing
     
122. End Sub
     

复制代码

tommyszeto

原帖由藍橋玄霜 於2010-4-25 09:49 發表
Private Sub CommandButton1_Click()
Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da, a12, jj&
Dim d, k, t, d1, k1, t1, aa, bb, k11, k22, ctr$
Set d = CreateObject("Scripting.Dictionary")
Set d1 = Creat ...

午安 藍橋玄霜老師:
多謝你多麼快的回覆!
但我不好意思再向老師說, 附件如下,尚有一點問題,
help me.zip (23.13 KB, 下载次数: 43)

2010-4-25 14:12 上传

点击文件名下载附件

老師還有, 發現了有一個別的事情, 因為如果已]有AutoFiter 及次序上的先後 , 就會影響了整體結果。

1. 想請問可以, 若遇有AutoFiter,便取消,運行後再行添加。

2. 運行前, 請先順序Sort如下是:
C4 (Cus2)
M4 (Series)
Z4 (RTA date)
E4 (Ctr2)

蓝桥玄霜

为什么会＝VIE/MSL/MAL/BFB/AAA/BBB？
不是只有ctr2中为3RD PARTY时，才从D列取资料的？

tommyszeto

原帖由 蓝桥玄霜 于 2010-4-25 15:21 发表
为什么会＝VIE/MSL/MAL/BFB/AAA/BBB？
不是只有ctr2中为3RD PARTY时，才从D列取资料的？

多謝您的問題澄清！對不起多麼久才回覆，事因電腦又壞機了。

老師說得全對的。可是附件上沒有3RD PARTY的字樣， 但都取了Ｄ列的資料，可能D列欄內有資料的存在，是嗎？

我或許在較早之前，解釋得糊里糊塗，其實欄內有多過不同的料資，就便加上分格符號 / 作合拼之用。

所以正確是VIE/MSL/MAL/BFB/AAA/BBB

即好像似LCH month一樣的。January/Febuary/March

請幫忙！

tommyszeto

晚安 藍橋玄霜老師:

我自己曾大膽賞試去修改，亂碰亂撞，但最終都不能成功，因才梳學淺。

help me.zip (22.7 KB, 下载次数: 3)

2010-4-26 23:36 上传

点击文件名下载附件

盼望儘快回覆, 謝謝!