標題: 求修改程式_搜尋並新增 [打印本頁]

---

作者: fangsc    時間: 2012-6-20 21:01     標題: 求修改程式_搜尋並新增

說明:
2個工作表"TC", "1" 以 "Code" & "Ser" 相同者
將工作表"1"的 6S, 6B, 7B,8B,9B 欄位資料
寫入工作表"TC" 的6S,6B,7B,8B,9B
如工作表"1" 有 "Code" & "Ser", 而 "TC"  沒有者
在"TC" 工作表 "I"欄 "Trade"的上2列新增一列並將 Code, Ser,6S,6B,7B,8B,9B資料填入

原程式:
Sub insert_backlog()
Dim fcsty, bklogy, TC_Maxrow, Backlog_Maxrow, start_col As Integer
Dim current_PL, current_ID As String
Dim search_PL, search_ID As String
TC_Maxrow = 103
Backlog_Maxrow = 42
start_col = 52
For fcsty = 3 To TC_Maxrow
current_PL = Worksheets("TC").Cells(fcsty, 10).FormulaR1C1
current_ID = Worksheets("TC").Cells(fcsty, 8).FormulaR1C1
Worksheets("1").Select
For bklogy = 2 To Backlog_Maxrow
search_PL = Worksheets("1").Cells(bklogy, 1).FormulaR1C1
If search_PL = current_PL Then
   search_ID = Worksheets("1").Cells(bklogy, 3).FormulaR1C1
  If (Val(search_ID) = Val(current_ID)) Then
        Worksheets("TC").Cells(fcsty, start_col).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 7).FormulaR1C1) / 1000
        Worksheets("TC").Cells(fcsty, start_col + 1).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 8).FormulaR1C1) / 1000
        Worksheets("TC").Cells(fcsty, start_col + 3).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 9).FormulaR1C1) / 1000
        Worksheets("TC").Cells(fcsty, start_col + 4).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 10).FormulaR1C1) / 1000
        Worksheets("TC").Cells(fcsty, start_col + 5).FormulaR1C1 = Val(Worksheets("1").Cells(bklogy, 11).FormulaR1C1) / 1000
  End If
End If
Next bklogy
Next fcsty
MsgBox ("己完成")
End Sub

感謝!!!!!

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)