设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › (非常感谢：蓝桥玄霜 老師 已解决!) 多項式條件而綜合的 ...
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123下一页
返回列表 发新帖
查看: 4390|回复: 26

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

[复制链接]
tommyszeto

TA的精华主题

TA的得分主题
发表于 2010-3-20 17:22 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
Book1.zip (7.26 KB, 下载次数: 47)

大家好，首先向你們說聲不好意思，事因為上載的附件裡有一些文字演示上會好含含糊糊，希望星級尊崇的大大，懇請見諒。
小弟更加希望各方好友，能夠幫忙我的複習問題，不勝感激。




非常感谢：蓝桥玄霜 老師 已解决。

[ 本帖最后由 tommyszeto 于 2010-5-2 02:25 编辑 ]
非常, 蓝桥, 老師, 解决
回复

举报

蓝桥玄霜

TA的精华主题

TA的得分主题
发表于 2010-3-20 21:20 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
  1. Sub tj()
  2. Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da
  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) = Format(aa(6), "dd-mmm-yy")
  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) = Format(Arr1(i + 1, 8), "dd-mmm-yy")
  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.         If InStr(Arr1(i + 1, 12), "/") > 0 Then
  71.             Arr1(i + 1, 12) = Left(Arr1(i + 1, 12), Len(Arr1(i + 1, 12)) - 1)
  72.         End If
  73.     Else
  74.         Arr1(i + 1, 12) = k(1)
  75.         Arr1(i + 1, 5) = Arr(Val(b), 22)
  76.         Arr1(i + 1, 6) = Arr(Val(b), 23)
  77.         Arr1(i + 1, 8) = Arr(Val(b), 27)
  78.     End If
  79. Next
  80. Sheet2.Activate
  81. [a11].Resize(UBound(Arr1), 13) = Arr1
  82. End Sub
复制代码

hktj0320.rar

16.25 KB, 下载次数: 45
回复

举报

tommyszeto

TA的精华主题

TA的得分主题
 楼主| 发表于 2010-3-20 22:12 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
原帖由 蓝桥玄霜 于 2010-3-20 21:20 发表
Sub tj()
Dim i&, Myr&, b, Arr, Arr1, x$, j&, ii&, da
Dim d, k, t, d1, k1, t1, aa, bb, k11, k22
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Myr = She ...


我真的出路遇貴人啊，區區花了小小的時間，就製成了多麼大的傑作。臺灣討論區www.excelhelp.net說需要花很多的時間及精神，才可完成此要求，然後捥拒於我。



但小弟再有個請求，以下得出的結果能否可以順序顯示呢？
LCH WK : WK31/WK23 => WK23/WK31
LCH Month : August/June = > June/August
回复

举报

zengsijun

TA的精华主题

TA的得分主题
发表于 2010-3-21 01:05 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
谢谢楼主的了，下来学习一下！！
回复

举报

tommyszeto

TA的精华主题

TA的得分主题
 楼主| 发表于 2010-3-21 01:42 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
hktj0320.zip (190.81 KB, 下载次数: 8)

早上好 蓝桥玄霜：

附件上還有小小的問題，請幫幫忙！
回复

举报

蓝桥玄霜

TA的精华主题

TA的得分主题
发表于 2010-3-21 09:25 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★

累计什么？

  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) = Format(aa(6), "dd-mmm-yy")
  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) = Format(Arr1(i + 1, 8), "dd-mmm-yy")
  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) = k(1)
  81.         Arr1(i + 1, 5) = 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. Next
  86. Sheet2.Activate
  87. [a11:m1000].ClearContents
  88. [a11].Resize(UBound(Arr1), 13) = Arr1
  89. Set d = Nothing
  90. Set d1 = Nothing

  92. End Sub
复制代码
回复

举报

tommyszeto

TA的精华主题

TA的得分主题
 楼主| 发表于 2010-3-21 12:23 | 显示全部楼层
[广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★
中午好 蓝桥玄霜：

再煩擾你， 真不好意思！
hktj0320.zip (192.44 KB, 下载次数: 10)

請你再看看Raw Data內的資料4241到4246行欄 及 NTG內的資料211行欄，是同屬組合，都合共5500數量 。但以下出現了像似累計不必要的資料在其中：

NTG正確顯示為
Planned Launch : WK40
Lch month : October

但可是

NTG顯示為
Planned Launch : WKIJK/WK40
Lch month : October : August/September/October/July/November/June


此外，請你再看看Raw Data內的資料174行欄 及 NTG內的資料32行欄，是單一體組合，都合共500數量 。但以下出現了像似亂碼資料在其中

NTG正確顯示為
Planned Launch : WK37
Ctr2 : FGH (因為基於3RD PARTY的字樣)

但可是

NTG顯示為
Planned Launch : 37
Lch month : October : GGG|BFT|5|Regular|Bady|1|2010/7/2
回复

举报

蓝桥玄霜

TA的精华主题

TA的得分主题
发表于 2010-3-22 09:31 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★

改好了

  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) = Format(aa(6), "dd-mmm-yy")
  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) = Format(Arr1(i + 1, 8), "dd-mmm-yy")
  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. Next
  88. Sheet2.Activate
  89. [a11:m1000].ClearContents
  90. [a11].Resize(UBound(Arr1), 13) = Arr1
  91. Set d = Nothing
  92. Set d1 = Nothing

  94. End Sub
复制代码
回复

举报

tommyszeto

TA的精华主题

TA的得分主题
 楼主| 发表于 2010-3-22 22:54 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
原帖由 蓝桥玄霜 于 2010-3-22 09:31 发表
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")
...


晚上好 尊崇的蓝桥玄霜：

向你說聲：「謝謝！」

我又遇上非常困難的事情，能否編修VBA程序是用只定的活頁為NTG呢？
未命名.zip (15.79 KB, 下载次数: 5)

及想添加IF的應用程式，如下：

1. 在== K11 == 欄以下
=IF(H11="","NO Classified",IF(H11="NO ETD","No planned ETD",IF(H11="TBA","PC can't provide planned ETD per schedule, assume they are late",IF(G11>=H11,"On-time",IF(H11-G11<=14,"Delay 1","Delay 2")))))

2. 在== M11 == 欄以下
=IF(OR(K11="Delay 2",K11="PC can't provide planned ETD per schedule, assume they are late"),"RED",IF(OR(K11="On-time",K11="Advance shipment 1",K11="Advance shipment 2"),"GREEN",IF(K11="Delay 1","RED",IF(K11="No planned ETD","WHITE",""))))

請幫助！
回复

举报

蓝桥玄霜

TA的精华主题

TA的得分主题
发表于 2010-3-23 10:27 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
  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) = Format(aa(6), "dd-mmm-yy")
  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) = Format(Arr1(i + 1, 8), "dd-mmm-yy")
  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 Arr1(i + 1, 7) >= 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

  116. End Sub
复制代码
回复

举报

下一页 »
123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

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

GMT+8, 2024-6-1 18:22 , Processed in 0.044288 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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