返回列表 上一主題 發帖

[發問] 請教改良方法，謝謝~

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-12-12 09:25 | 顯示全部帖子

[發問] 請教改良方法，謝謝~

  1. Sub Detail()
  2. Dim FRng As Range
  3. Dim A As Range, Rng As Range
  4. Dim i As Integer
  5. Dim LastRec As Integer
  6. Dim k As Integer
  7. Dim j As Integer
  8.    
  9.     k = Sheets("state").Range("A1").CurrentRegion.Rows.Count
  10.          For j = 2 To k
  11.      If IsError(Application.VLookup(Worksheets("state").Range("A" & j).Value, Sheets("Result").Range("A:B"), 1, False)) Then
  12.              Sheets("State").Cells(j, "B") = Worksheets("Result").Range("S" & j).Value
  13.              Sheets("State").Cells(j, "O") = Worksheets("Result").Range("L" & j).Value
  14.              Sheets("State").Cells(j, "F") = Worksheets("Result").Range("E" & j).Value
  15.              Sheets("State").Cells(j, "K") = Worksheets("Result").Range("U" & j).Value
  16.              Sheets("State").Cells(j, "L") = Worksheets("Result").Range("V" & j).Value
  17.              Sheets("State").Cells(j, "P") = Worksheets("Result").Range("AL" & j).Value
  18.              Sheets("State").Cells(j, "Q") = Worksheets("Result").Range("Q" & j).Value
  19.              Sheets("State").Cells(j, "R") = Worksheets("Result").Range("M" & j).Value
  20.              Sheets("State").Cells(j, "S") = Worksheets("Result").Range("N" & j).Value
  21.              Sheets("State").Cells(j, "T") = Worksheets("Result").Range("X" & j).Value
  22.              Sheets("State").Cells(j, "U") = Worksheets("Result").Range("Z" & j).Value
  23.              Sheets("State").Cells(j, "W") = Worksheets("Result").Range("K" & j).Value
  24.              Sheets("State").Cells(j, "X") = Worksheets("Result").Range("C" & j).Value
  25.             
  26.             End If
  27.        Next

  29. fs = "W:\PIHK\NEW香港辦公室正本收放單記錄FROM 01-MAR-2012 to current(updated).xlsx"
  30. Set Wb = Workbooks.Open(fs)
  31. With ThisWorkbook.Worksheets("State")
  32. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  33.      Set FRng = Wb.Sheets("收單記錄").Range("C:C").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  34.      If Not FRng Is Nothing Then
  35.            A.Offset(, 9) = FRng.Offset(, 4).Value
  36.            If Rng Is Nothing Then Set Rng = A.Offset(, 7) Else Set Rng = Union(Rng, A.Offset(, 7))
  37.         End If
  38.            Set FRng = Nothing
  39. Next
  40. End With
  41. Wb.Close 0

  43.   fs = "W:\PIHK\NEW香港辦公室正本收放單記錄FROM 01-MAR-2012 to current(updated).xlsx"
  44. Set Wb = Workbooks.Open(fs)
  45. With ThisWorkbook.Worksheets("State")
  46. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  47.      Set FRng = Wb.Sheets("放單記錄").Range("C:C").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  48.      If Not FRng Is Nothing Then
  49.            A.Offset(, 21) = FRng.Offset(, 4).Value
  50.            If Rng Is Nothing Then Set Rng = A.Offset(, 21) Else Set Rng = Union(Rng, A.Offset(, 21))
  51.         End If
  52.            Set FRng = Nothing
  53. Next
  54. End With
  55. Wb.Close 0

  57. fs = "W:\Payment Daily Report\Brazil shipment schedule.xlsx"
  58.   Set Wb = Workbooks.Open(fs)
  59. With ThisWorkbook.Worksheets("State")
  60. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  61.      Set FRng = Wb.Sheets("sheet1").Range("D:D").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  62.      If Not FRng Is Nothing Then
  63.            A.Offset(, 7) = FRng.Offset(, 10).Value
  64.            If Rng Is Nothing Then Set Rng = A.Offset(, 5) Else Set Rng = Union(Rng, A.Offset(, 5))
  65.         End If
  66.            Set FRng = Nothing
  67. Next
  68. End With
  69. Wb.Close 0

  71. fs = "W:\Payment Daily Report\daily doc.xlsx"

  73. 'fs = ThisWorkbook.Path & "\payment report 2012.xlsx"
  74. Set Wb = Workbooks.Open(fs)
  75. With ThisWorkbook.Worksheets("State")
  76. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  77.      Set FRng = Wb.Sheets("DAILY").Range("D:D").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  78.      If Not FRng Is Nothing Then
  79.            A.Offset(, 13) = FRng.Offset(, 3).Value
  80.            If Rng Is Nothing Then Set Rng = A.Offset(, 11) Else Set Rng = Union(Rng, A.Offset(, 11))
  81.         End If
  82.            Set FRng = Nothing
  83. Next
  84. End With
  85. Wb.Close 0

  87.   fs = "W:\Payment Daily Report\JPMHK RECEIVED RECORD.xlsx"
  88. Set Wb = Workbooks.Open(fs)
  89. With ThisWorkbook.Worksheets("State")
  90. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  91.      Set FRng = Wb.Sheets("NEW TC ITEMS").Range("C:C").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  92.      If Not FRng Is Nothing Then
  93.            A.Offset(, 8) = FRng.Offset(, 10).Value
  94.            If Rng Is Nothing Then Set Rng = A.Offset(, 6) Else Set Rng = Union(Rng, A.Offset(, 6))
  95.         End If
  96.            Set FRng = Nothing
  97. Next
  98. End With
  99. Wb.Close 0

  101.    fs = "W:\Payment Daily Report\Outstanding Payments.xlsm"
  102. Set Wb = Workbooks.Open(fs)
  103. With ThisWorkbook.Worksheets("State")
  104. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  105.      Set FRng = Wb.Sheets("outstanding payments").Range("A:A").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  106.      If Not FRng Is Nothing Then
  107.            A.Offset(, 6) = FRng.Offset(, 4).Value
  108.            If Rng Is Nothing Then Set Rng = A.Offset(, 4) Else Set Rng = Union(Rng, A.Offset(, 6))
  109.         End If
  110.        Set FRng = Nothing
  111. Next
  112. End With
  113. Wb.Close 0

  115.     fs = "W:\Payment Daily Report\payment report.xlsx"
  116. Set Wb = Workbooks.Open(fs)
  117. With ThisWorkbook.Worksheets("State")
  118. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  119.      Set FRng = Wb.Sheets("New form of payment report").Range("B:B").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  120.      If Not FRng Is Nothing Then
  121.            A.Offset(, 12) = FRng.Offset(, 7).Value
  122.            If Rng Is Nothing Then Set Rng = A.Offset(, 10) Else Set Rng = Union(Rng, A.Offset(, 10))
  123.         End If
  124.            Set FRng = Nothing
  125. Next
  126. End With
  127. Wb.Close 0


  130. fs = "W:\Payment Daily Report\HK ETA update.xlsx"
  131. Set Wb = Workbooks.Open(fs)
  132. With ThisWorkbook.Worksheets("State")
  133. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  134.      Set FRng = Wb.Sheets("香港&海防單").Range("A:A").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  135.      If Not FRng Is Nothing Then
  136.            A.Offset(, 2) = FRng.Offset(, 11).Value
  137.            If Rng Is Nothing Then Set Rng = A.Offset(, 2) Else Set Rng = Union(Rng, A.Offset(, 2))
  138.         End If
  139.            Set FRng = Nothing
  140. Next
  141. End With
  142. Wb.Close 0

  144.   fs = "W:\Payment Daily Report\Mainland ETA Update.xlsx"
  145. Set Wb = Workbooks.Open(fs)
  146. With ThisWorkbook.Worksheets("State")
  147. For Each A In .Range(.[A2], .Range("A1").End(xlDown))
  148.      Set FRng = Wb.Sheets("MAILAND ETA").Range("A:A").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
  149.      If Not FRng Is Nothing Then
  150.            A.Offset(, 3) = FRng.Offset(, 9).Value
  151.            If Rng Is Nothing Then Set Rng = A.Offset(, 3) Else Set Rng = Union(Rng, A.Offset(, 3))
  152.         End If
  153.            Set FRng = Nothing
  154. Next
  155. End With
  156. Wb.Close 0

  158. End Sub
複製代碼
另外下面這兩個可否改成如果在"W:\Payment Daily Report\HK ETA update.xlsx"Sheets("香港&海防單") 內找到A.Offset(, 2) = FRng.Offset(, 11).Value，如果找不到就在"W:\Payment Daily Report\Mainland ETA Update.xlsx" Sheets("MAILAND ETA")內找，如果找到就A.Offset(, 2) = FRng.Offset(, 9).Value，如果兩個都找不到就將A.Offset(, 2) 就不變，維持原本的資料。

fs = "W:\Payment Daily Report\HK ETA update.xlsx"
Set Wb = Workbooks.Open(fs)
With ThisWorkbook.Worksheets("State")
For Each A In .Range(.[A2], .Range("A1").End(xlDown))
     Set FRng = Wb.Sheets("香港&海防單").Range("A:A").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
     If Not FRng Is Nothing Then
           A.Offset(, 2) = FRng.Offset(, 11).Value
           If Rng Is Nothing Then Set Rng = A.Offset(, 2) Else Set Rng = Union(Rng, A.Offset(, 2))
        End If
           Set FRng = Nothing
Next
End With
Wb.Close 0

  fs = "W:\Payment Daily Report\Mainland ETA Update.xlsx"
Set Wb = Workbooks.Open(fs)
With ThisWorkbook.Worksheets("State")
For Each A In .Range(.[A2], .Range("A1").End(xlDown))
     Set FRng = Wb.Sheets("MAILAND ETA").Range("A:A").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
     If Not FRng Is Nothing Then
           A.Offset(, 3) = FRng.Offset(, 9).Value
           If Rng Is Nothing Then Set Rng = A.Offset(, 3) Else Set Rng = Union(Rng, A.Offset(, 3))
        End If
           Set FRng = Nothing
Next
End With
Wb.Close 0
收藏 分享

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
返回列表 上一主題