返回列表 上一主題 發帖

程式補充

fangsc

帖子
81 
主題
27 
精華
0 
積分
151 
點名
0  
作業系統
win7 
軟體版本
office2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2012-6-7 
最後登錄
2020-11-27 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-8-7 23:38 | 只看該作者

程式補充

Load data.rar (53.02 KB)

請教附件裡的程式如何補充:

如果符合條件者,將來源資料的那一列,加上有顏色的底色,並將數字寫進目的工作表,

If Val(search_PL) = Val(current_PL) And Val(search_cust_ID) = Val(current_cust_ID) Then
        Worksheets("TC").Cells(fcsty, start_col_in_TC).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 7).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 1).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 8).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 3).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 9).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 4).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 10).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 5).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 11).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 50).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 14).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 51).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 15).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 52).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 16).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 53).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 17).FormulaR1C1)
        Worksheets("TC").Cells(fcsty, start_col_in_TC + 54).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 18).FormulaR1C1)
End If
收藏 分享
fangac

fangsc

帖子
81 
主題
27 
精華
0 
積分
151 
點名
0  
作業系統
win7 
軟體版本
office2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2012-6-7 
最後登錄
2020-11-27 

論壇贊助勳章
3#
發表於 2012-8-8 23:14 | 只看該作者
回復 2# GBKEE

感謝版主的修正與補充.
查了 "ubound"  是取得是數组的元素數
學到了"ubound"的用法. 謝謝你.
fangac

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-8-8 07:49 | 只看該作者
回復 1# fangsc
  1. Sub Loaddata()
  2. Dim fcsty, bklogy As Integer
  3. Dim current_PL, current_cust_ID As String
  4. Dim search_PL, search_cust_ID As String
  5. Dim TC_Maxrow As Integer
  6. Dim Backlog_maxrow As Integer
  7. Dim start_col_in_TC As Integer
  8. Dim PL_index_col, CID_index_col As Integer
  9. '-----------------------------
  10. Dim Ar(1 To 2), xi As Integer, MyColorIndex As Integer
  11. '-----------------------------
  12. PL_index_col = 1
  13. CID_index_col = 3
  14. TC_Maxrow = 16
  15. Backlog_maxrow = 17
  16. start_col_in_TC = 58
  17. '----------------------------------------------
  18. Ar(1) = Array(0, 1, 3, 4, 5, 50, 51, 52, 53, 54)
  19. Ar(2) = Array(7, 8, 9, 10, 11, 14, 15, 16, 17, 18)
  20. MyColorIndex = 7                       '底色 數值
  21. '----------------------------------------------
  22. Worksheets("TC").Activate
  23. For fcsty = 2 To TC_Maxrow
  24.     search_PL = Worksheets("TC").Cells(fcsty, 16) '.FormulaR1C1
  25.     search_cust_ID = Worksheets("TC").Cells(fcsty, 13) '.FormulaR1C1
  26.     'Worksheets("1").Select
  27.     For bklogy = 2 To Backlog_maxrow
  28.         current_PL = Worksheets("1").Cells(bklogy, PL_index_col) '.FormulaR1C1
  29.         current_cust_ID = Worksheets("1").Cells(bklogy, CID_index_col) '.FormulaR1C1
  30.         If Val(search_PL) = Val(current_PL) And Val(search_cust_ID) = Val(current_cust_ID) Then
  31.         ' 條件符合時,將worksheet "1"的current_PL 及 current_cust_ID 加上底色,再執行以下寫入資料
  32.             Worksheets("1").Cells(bklogy, PL_index_col).Interior.ColorIndex = MyColorIndex
  33.             Worksheets("1").Cells(bklogy, CID_index_col).Interior.ColorIndex = MyColorIndex
  34.             For xi = 0 To UBound(Ar(1))
  35.                 Worksheets("TC").Cells(fcsty, start_col_in_TC + Ar(1)(xi)) = Val(Worksheets("1").Cells(bklogy, Ar(2)(xi)))
  36.             Next
  37.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 7).FormulaR1C1)
  38.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 1).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 8).FormulaR1C1)
  39.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 3).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 9).FormulaR1C1)
  40.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 4).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 10).FormulaR1C1)
  41.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 5).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 11).FormulaR1C1)
  42.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 50).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 14).FormulaR1C1)
  43.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 51).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 15).FormulaR1C1)
  44.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 52).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 16).FormulaR1C1)
  45.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 53).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 17).FormulaR1C1)
  46.             ' Worksheets("TC").Cells(fcsty, start_col_in_TC + 54).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 18).FormulaR1C1)
  47.         End If
  48.     Next 'bklogy
  49. Next 'fcsty
  50. End Sub
複製代碼

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題