123
返回列表 上一主題 發帖

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

p6703

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

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

TOP

p6703

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

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

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
13#
發表於 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 

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

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
15#
發表於 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 

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

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

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
17#
發表於 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 

論壇贊助勳章
18#
發表於 2012-5-3 19:14 | 只看該作者
的確有如Hsieh版主所說的狀況，但即使我將日期最小值已更新至5/1起，但執行時仍發生錯誤，附上檔案，煩請Hsieh版主解惑，謝謝!!!
Book1.rar (15.27 KB)

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
19#
發表於 2012-5-3 19:32 | 只看該作者
回復 18# 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.        If x > 0 Then ar(0, x) = ar(0, x) + A.Offset(, 3) '需求避免Sheet1內需求日無日期
  29.        If y > 0 Then ar(1, y) = A.Offset(, 3) '交期避免Sheet1內交期無日期
  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 

論壇贊助勳章
20#
發表於 2012-5-3 21:38 | 只看該作者
真是太感謝Hsieh版主，解決了小弟的大問題，執行已可自動套出

如果小弟想再加入多一些的資料（例原只有訂單,料號,項次，想再增加客戶,規格...）==>已更新附件中，請問如何修改???

小弟有自己測試修改，但功力實在不足，改後還是無法套出正確資料，故煩請Hsieh版主幫忙

Book2.rar (16.01 KB)

TOP

        靜思自在 : 生氣，就是拿別人的過錯來懲罰自己。
123
返回列表 上一主題