123
返回列表 上一主題 發帖

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

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
18# 跳轉到 »
發表於 2012-5-3 14:20 | 只看該作者
回復 16# p6703

我猜想是你的Sheet2!E2的日期比所有訂單日期的最小值還大，才會產生這樣結果
請上傳出錯檔案才能知道確實原因
學海無涯_不恥下問

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
17#
發表於 2012-5-3 08:43 | 只看該作者
感謝Hsieh兄的回覆,小弟按最新程式碼執行後,卻跑出"執行階段錯誤'9'，陣列索引超出範圍"，並停在ar(0, x) = ar(0, x) + A.Offset(, 3)此程式碼，因我現執行的筆數有快200筆，是有設限筆數嗎???

還有原提供報表中僅有"訂單＂，"料號"，"項次"三資料，但如果要再增加幾筆資料，原程式碼是否即需再修改???

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
16#
發表於 2012-5-2 22:33 | 只看該作者
本帖最後由 Hsieh 於 2012-5-2 22:35 編輯

回復 14# p6703

如果以2010版本開啟檔案時，因為工作表的codename是"工作表1"、"工作表2"...等，並非"Sheet1"、"Sheet2"...等
所以出錯。
請檢查工作表的CodeName是否存在?

最後的發帖中已經改成使用工作表的Name屬性，若有錯誤請檢查工作表名稱。

學海無涯_不恥下問

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
15#
發表於 2012-5-2 22:22 | 只看該作者
先感謝Hsieh版主了,明日再測試看看,但上一個問題仍想請問,就是如單複製代碼,因何執行巨集會跑出錯誤呢...
Hsieh版主的巨集,大大降低工作量,真的太感謝你了

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2012-5-2 18:33 | 只看該作者
回復 12# p6703
  1. Sub Ex()
  2. Dim A As Range, x%, y%
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets("Sheet2")
  5. s = Application.Min(.Rows(1))
  6. With Sheets("Sheet1")
  7. n = Application.Max(.Columns("E:F")) - s + 4
  8.    For Each A In .Range(.[A2], .[A2].End(xlDown))
  9. ReDim ar(0 To 1, 0 To n)
  10.        m = A & "," & A.Offset(, 1) & "," & A.Offset(, 2)
  11.        If IsEmpty(d(m)) Then
  12.        GoTo 10
  13.        Else
  14.        For i = 0 To 1
  15.          For j = 0 To n
  16.            ar(i, j) = d(m)(i, j)
  17.          Next
  18.        Next
  19.        End If
  20. 10
  21.        x = A.Offset(, 4) - s + 4 '需求日
  22.        y = A.Offset(, 5) - s + 4 '交期
  23.        For i = 0 To 2
  24.          ar(0, i) = A.Offset(, i)
  25.        Next
  26.        ar(0, 3) = "需求日"
  27.        ar(1, 3) = "交期"
  28.        ar(0, x) = ar(0, x) + A.Offset(, 3) '需求
  29.        ar(1, y) = A.Offset(, 3)
  30.        d(m) = ar
  31.        Erase ar
  32.    Next
  33. End With
  34. r = 2
  35. For Each ky In d.keys
  36.   .Cells(r, 1).Resize(2, n + 1) = d(ky)
  37.   r = r + 2
  38. Next
  39. End With
  40. End Sub
複製代碼
學海無涯_不恥下問

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
13#
發表於 2012-5-2 17:26 | 只看該作者
Hsieh 版主因小弟實際排程有時會有跨月的問題，例：需求日5/20，交期回覆到6/10，但按目前巨集執行發現僅比對"日"而已，如按以上日期，其交期對應的會秀到5/10，此是否可再修正???

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
12#
發表於 2012-4-29 12:43 | 只看該作者
感謝Hsieh 版主，小弟將代碼複製要執行時，又在"n = .Cells(1, .Columns.Count).End(xlToLeft).Column - 1”此列跑出"執行階段錯誤 '424': 此處需要物件"的警告視窗，是除了複製外還有需要再做什麼的設定嗎???

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
11#
發表於 2012-4-27 23:59 | 只看該作者
本帖最後由 Hsieh 於 2012-4-28 00:11 編輯

回復 4# p6703
  1. Sub Ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet2
  5. n = .Cells(1, .Columns.Count).End(xlToLeft).Column - 1
  6. s = Day(.[E1])
  7. With Sheet1
  8.    For Each A In .Range(.[A2], .[A2].End(xlDown))
  9. ReDim ar(0 To 1, 0 To n)
  10.        m = A & "," & A.Offset(, 1) & "," & A.Offset(, 2)
  11.        If IsEmpty(d(m)) Then
  12.        GoTo 10
  13.        Else
  14.        For i = 0 To 1
  15.          For j = 0 To n
  16.            ar(i, j) = d(m)(i, j)
  17.          Next
  18.        Next
  19.        End If
  20. 10
  21.        x = Day(A.Offset(, 4)) - s + 4 '需求日
  22.        y = Day(A.Offset(, 5)) - s + 4 '交期
  23.        For i = 0 To 2
  24.          ar(0, i) = A.Offset(, i)
  25.        Next
  26.        ar(0, 3) = "需求日"
  27.        ar(1, 3) = "交期"
  28.        ar(0, x) = ar(0, x) + A.Offset(, 3) '需求
  29.        ar(1, y) = A.Offset(, 3)
  30.        d(m) = ar
  31.        Erase ar
  32.    Next
  33. End With
  34. r = 2
  35. For Each ky In d.keys
  36.   .Cells(r, 1).Resize(2, n + 1) = d(ky)
  37.   r = r + 2
  38. Next
  39. End With
  40. End Sub
複製代碼
學海無涯_不恥下問

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
10#
發表於 2012-4-27 23:18 | 只看該作者
小弟先摸索看看了.再次感謝register313兄^^

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
9#
發表於 2012-4-25 22:27 | 只看該作者
感謝register313兄，可以執行了，但小弟不明白，程式碼一樣，因何小弟自己複製貼上的就不行呢???還有小弟接觸vba不久，不知是否可請register313兄針對程式碼小小說明一下，謝謝...

TOP

        靜思自在 : 君子立恆志，小人恆立志。
123
返回列表 上一主題