Board logo

標題: 請幫忙翻譯一下程式 [打印本頁]
作者: 198188    時間: 2012-12-8 10:22     標題: 請幫忙翻譯一下程式

有兩個excel，分別是a.xlsx 和b.xlsx
我想在a.xlsx些vba, 讀取b.xlsx的資料。
請問我應該如何寫
for i = b.xlsx的最後一筆 to 1
因為我想用b.xlsx最後一欄開始往上檢查a.xlsx
但不知道怎樣寫才可以知道b.xlsx的最後一筆

Sub ex()
Dim FRng As Range
Dim A As Range, Rng As Range
  fs = "c:\user\destop\b.xlsx"
'fs = ThisWorkbook.Path & "\b.xlsx"
set wb = Workbooks.Open(fs)
     Set FRng = wb.Sheets("sheet1").Range("k:k").Find(today(), lookat:=xlWhole, SearchDirection:=xlPrevious) 在b.xlsx 的K欄尋找等當日的日期的一列
     If Not FRng Is Nothing Then 假如找到
        If FRng.Offset(, -3).Value >= 0.95 Then 假如b.xlsx 這列的H欄的值大過或等於0.95
set rng = workbooks(a).range("a:a").find(Frng.offset(,-9), lookat:=xlWhole, SearchDirection:=xlPrevious)     在a.xlsx 的A欄尋找b.xlsx 這列的B欄的值是否存在
If FRng Is Nothing Then  假如找不到
                在a.xlsx 的A欄最後一列加上b.xlsx 這列的B欄的值，及   在a.xlsx 的F欄最後一列加上b.xlsx 這列的K欄的值

end sub
作者: GBKEE    時間: 2012-12-8 11:20

回復 1# 198188
  1. Option Explicit
  2. Sub Ex()
  3.     Dim fs As String, xi As Integer
  4.     fs = "c:\user\destop\b.xlsx"
  5.     'fs = ThisWorkbook.Path & "\b.xlsx"
  6.     'Set wb = Workbooks.Open(fs)
  7.     'With Wb.Sheets("sheet1")
  8.     With Workbooks.Open("d:\book1.xls").Sheets("sheet1")
  9.       For xi = .UsedRange.Cells(.UsedRange.Count).Row To 1 Step -1
  10.              '由小到大:不必 Step  但如要間隔執行如:  Step 5
  11.             MsgBox .UsedRange.Cells(xi, "A").Address  'A欄
  12.       Next
  13.     End With
  14. End Sub
複製代碼
作者: 198188    時間: 2012-12-8 11:59

回復 2# GBKEE

[attach]13451[/attach][attach]13452[/attach]
Sub ex()
Dim FRng As Range
Dim A As Range, Rng As Range
Dim fs As String, xi As Integer
   fs = "C:\Documents and Settings\USER\桌面\b.xlsx"
  set wb = Workbooks.Open(fs)
     Set FRng = wb.Sheets("sheet1").Range("k:k").Find(today(), lookat:=xlWhole, SearchDirection:=xlPrevious) 在b.xlsx 的K欄尋找等當日的日期的一列
        If Not FRng Is Nothing Then 假如找到
        If FRng.Offset(, -3).Value >= 0.95 Then 假如b.xlsx 這列的H欄的值大過或等於0.95
  set rng = workbooks(a).range("a:a").find(Frng.offset(,-9), lookat:=xlWhole, SearchDirection:=xlPrevious)     在a.xlsx 的A欄尋找b.xlsx 這列的B欄的值是否存在
         If FRng Is Nothing Then  假如找不到
          With Workbooks.Open("a.xlsm").Sheets("outstanding payments")    在a.xlsx 的A欄最後一列加上b.xlsx 這列的B欄的值，及   在a.xlsx 的F欄最後一列加上b.xlsx 這列的K欄的值
           xi = .UsedRange.Cells(.UsedRange.Count).Row
             .UsedRange.Cells(xi, "A") = FRng.offset(, -9).value
           .UsedRange.Cells(xi, "F") = FRng.value
         End With
         End If
     End If
End If
End Sub

請問程式文化有問題嗎？
作者: GBKEE    時間: 2012-12-8 12:55

回復 3# 198188
是文法不是文化.
當日的日期: today()這是工作表函數 ,VBA ->  Date
  1. Option Explicit
  2. Sub ex()
  3.     Dim FRng As Range, Wb As Workbook
  4.     Dim A As Range, Rng As Range
  5.     Dim fs As String, xi As Integer
  6.     fs = "C:\Documents and Settings\USER\桌面\b.xlsx"
  7.     Set Wb = Workbooks.Open(fs)
  8.     Set FRng = Wb.Sheets("sheet1").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious) '在b.xlsx 的K欄尋找等當日的日期的一列
  9.     If Not FRng Is Nothing Then                 '假如找到
  10.         If FRng.Offset(, -3).Value >= 0.95 Then '假如b.xlsx 這列的H欄的值大過或等於0.95
  11.             '*** Workbooks(A)-> A這變數字串沒有見到  ****
  12.             Set Rng = Workbooks(A).Range("a:a").Find(FRng.Offset(, -9), lookat:=xlWhole, SearchDirection:=xlPrevious)   ' 在a.xlsx 的A欄尋找b.xlsx 這列的B欄的值是否存在
  13.             If FRng Is Nothing Then             '假如找不到
  14.                 With Workbooks.Open("a.xlsm").Sheets("outstanding payments")  '   在a.xlsx 的A欄最後一列加上b.xlsx 這列的B欄的值，及   在a.xlsx 的F欄最後一列加上b.xlsx 這列的K欄的值
  15.                     xi = .UsedRange.Cells(.UsedRange.Count).Row
  16.                     .UsedRange.Cells(xi, "A") = FRng.Offset(, -9).Value
  17.                     .UsedRange.Cells(xi, "F") = FRng.Value
  18.                 End With
  19.             End If
  20.         End If
  21.     End If
  22. End Sub
複製代碼
ps: 回覆時 按下[代碼] 將程式碼內容貼上,提交,即可便於查看者,複製程式碼.
作者: 198188    時間: 2012-12-8 14:44

回復 4# GBKEE


    請問除了Today的語法有問題外,還有沒有其他地方有語法問題?
作者: GBKEE    時間: 2012-12-8 14:49

回復 5# 198188
執行上: 有錯誤嗎? 沒有得到你的期望嗎?
沒錯誤,有得到你的期望,那還有什麼??
作者: 198188    時間: 2012-12-8 15:12

回復 6# GBKEE


    還沒試!因為我在外面用手機上網無法測試!雖然明白概念但因為自己語法能力弱,難以表達,所以先問清楚,回去試可以輕鬆些
作者: 198188    時間: 2012-12-8 22:51

回復 4# GBKEE

[attach]13466[/attach]

只是打開了另外一個Excel，其他完全沒有反應。   
是不是有那些地方出錯了？
作者: c_c_lai    時間: 2012-12-9 08:23

回復 8# 198188
請檢查 fs = "C:\Documents and Settings\USER\桌面\b.xlsx"
USER 是誰， 它僅是提醒你那指的是操作使用者，當然你就得換上正名了！
作者: 198188    時間: 2012-12-9 09:20

本帖最後由 198188 於 2012-12-9 09:22 編輯

回復 9# c_c_lai

C:\Documents and Settings\USER\桌面
    我是用user的名稱來命名這台電腦，所以這句沒錯。
我要開的另一個excel （b.xlsx）是打開了，但是執行沒有什麼做出來
作者: 198188    時間: 2012-12-9 09:44

回復 9# c_c_lai
[attach]13473[/attach][attach]13474[/attach]
  1. Option Explicit

  3. Sub ex()

  5.     Dim FRng As Range, Wb As Workbook

  7.     Dim A As Range, Rng As Range

  9.     Dim fs As String, xi As Integer
  10.     fs = "C:\Documents and Settings\USER\桌面\payment report 2012.xlsx"

  12.     Set Wb = Workbooks.Open(fs)

  14.     Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious) '在b.xlsx 的K欄尋找等當日的日期的一列

  16.     If Not FRng Is Nothing Then                 '假如找到

  18.         If FRng.Offset(, -3).Value >= 0.95 Then '假如b.xlsx 這列的H欄的值大過或等於0.95

  20.             '*** Workbooks(A)-> A這變數字串沒有見到  ****

  22.             Set Rng = Workbooks("outstanding payments").Sheets("outstanding payments").Range("a:a").Find(FRng.Offset(, -9), lookat:=xlWhole, SearchDirection:=xlPrevious)   ' 在a.xlsx 的A欄尋找b.xlsx 這列的B欄的值是否存在

  24.             If FRng Is Nothing Then             '假如找不到

  26.                 With Workbooks.Open("outstanding payments.xlsm").Sheets("outstanding payments")  '   在a.xlsx 的A欄最後一列加上b.xlsx 這列的B欄的值，及   在a.xlsx 的F欄最後一列加上b.xlsx 這列的K欄的值

  28.                     xi = .UsedRange.Cells(.UsedRange.Count).Row

  30.                     .UsedRange.Cells(xi, "A") = FRng.Offset(, -9).Value

  32.                     .UsedRange.Cells(xi, "F") = FRng.Value
  33.                   
  34.                 End With

  36.             End If

  38.         End If

  40.     End If
  41. Wb.Close 0
  42. End Sub
複製代碼
效果是想當payment report 2012 內K欄是今天的日期，而H欄的%達到95%或以上，加上B欄的 SO#在outstanding payments 表內沒有的話，就把payment report 2012 內H欄的%達到95%或以上，及B欄的 SO#在outstanding payments 表內沒有的SO＃ 放在outstanding payments 表內的A欄的最後一列上 及F欄的日期copy過去相應位置。
如圖中outstanding payment 黃色的部分。
作者: c_c_lai    時間: 2012-12-9 09:52

回復 10# 198188
假設 K 欄原本之日期為  12/8， 為配合測試將它們均改成 12/9 今日。
Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious)
則 FRng 搜尋結果是指向 FRng.Address : "$K$28" 該條件吻合之最後一項，
而該列 H 欄 FRng.Offset(, -3).Value : 0 (該欄係空白欄)，
結論是 If FRng.Offset(, -3).Value >= 0.95 Then 不成立。
作者: 198188    時間: 2012-12-9 18:19

回復 12# c_c_lai


    有空列就無法運行?但是我之前也用這句尋找B欄如有而H欄百份比達九十五或以上就將K欄日期傳回!同樣有空列但運作就無問題,是何處出錯?
作者: c_c_lai    時間: 2012-12-9 20:12

回復 13# 198188
[attach]13485[/attach]
作者: 198188    時間: 2012-12-9 22:58

回復 14# c_c_lai


    我試過將H28改成20% 或者100%，但是仍然沒有反應。
另外Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious) 是不是不停地向上找？那麼K28一列達不到要求，不是會再向上尋找嗎？
作者: 198188    時間: 2012-12-9 23:21

回復 4# GBKEE
  1. ption Explicit

  3. Sub ex()

  5.     Dim FRng As Range, Wb As Workbook

  7.     Dim A As Range, Rng As Range

  9.     Dim fs As String, xi As Integer
  10.     fs = "C:\Documents and Settings\USER\桌面\payment report 2012.xlsx"

  12.     Set Wb = Workbooks.Open(fs)

  14.     Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious) '在b.xlsx 的K欄尋找等當日的日期的一列

  16.     If Not FRng Is Nothing Then                 '假如找到

  18.         If FRng.Offset(, -3).Value >= 0.95 [color=Red]And FRng.Offset(, -3).Value <> " "[/color] Then  '假如b.xlsx 這列的H欄的值大過或等於0.95

  20.             Set Rng = Workbooks("outstanding payments").Sheets("outstanding payments").Range("a:a").Find(FRng.Offset(, -9), lookat:=xlWhole, SearchDirection:=xlPrevious)   ' 在a.xlsx 的A欄尋找b.xlsx 這列的B欄的值是否存在

  22.             [color=Red]If Rng Is Nothing Then             [/color]'假如找不到

  24.                 [color=Red]With Workbooks("outstanding payments").[/color]Sheets("outstanding payments")  '   在a.xlsx 的A欄最後一列加上b.xlsx 這列的B欄的值，及   在a.xlsx 的F欄最後一列加上b.xlsx 這列的K欄的值

  26.                     xi = .UsedRange.Cells(.UsedRange.Count).Row

  28.                     .UsedRange.Cells(xi, "A") = FRng.Offset(, -9).Value

  30.                     .UsedRange.Cells(xi, "F") = FRng.Value
  31.                   
  32.                 End With

  34.             End If
  35.            
  36.         End If

  38.     End If
  39.    Wb.Close 0
  40. End Sub
複製代碼
之前If Rng Is Nothing Then   寫錯成 If FRng Is Nothing Then ，但是改完了也沒有反應，只是打開另一個excel後就沒有什麼反應，是哪裡出現問題了，請指定迷津。 不管最後一列是否H欄是否空格或者百份之幾都沒有反應，另外 Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious) 是否會不停地往上尋找,直到第一列為止？
作者: c_c_lai    時間: 2012-12-10 08:05

回復 16# 198188
你可以參考 kai6929 先進提供的：
銷售管理完成版
#19 附件內有關的 AdvancedFilter  的過濾條件的處理。
之後再來思維 Outstanding Payments 接下來的動作。
作者: stillfish00    時間: 2012-12-10 15:02

回復 16# 198188
對函數(Find)用法不清楚時 , 可以自己先查詢Excel說明 ,
這樣可以更了解它的各參數用途 , 裡面也有例子可參考

Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious)
這行只是 在K欄找到最後一筆符合Date的儲存格 ,
有找到 -> FRng設為該儲存格
沒找到 -> FRng = nothing
就只找一次而已

你要在每個符合Date的儲存格都另外判斷條件
可以參考 Excel說明的範例去改寫
範例 :
        這個範例會在第一張工作表上的 A1:A500 範圍內尋找值為 2 的所有儲存格，並將這些儲存格的值變更為 5。
  1. With Worksheets(1).Range("a1:a500")
  2.     Set c = .Find(2, lookin:=xlValues)
  3.     If Not c Is Nothing Then
  4.         firstAddress = c.Address
  5.         Do
  6.             c.Value = 5
  7.             Set c = .FindNext(c)
  8.         Loop While Not c Is Nothing And c.Address <> firstAddress
  9.     End If
  10. End With
複製代碼
作者: 198188    時間: 2012-12-11 23:50

回復 18# stillfish00
  1. Option Explicit

  3. Sub ex()
  4.    
  5.     Dim FRng As Range, Wb As Workbook
  6.     Dim FirstAddress As String
  7.     Dim A As Range, Rng As Range

  9.     Dim fs As String, xi As Integer
  10.     fs = "C:\Documents and Settings\USER\桌面\payment report 2012.xlsx"

  12.     Set Wb = Workbooks.Open(fs)

  14.     Set FRng = Wb.Sheets("New form of payment report").Range("k:k").Find(Date, lookat:=xlWhole, SearchDirection:=xlPrevious) '在b.xlsx 的K欄尋找等當日的日期的一列

  16.     If Not FRng Is Nothing Then '假如找到

  18.         
  19.         If FRng.Offset(, -3).Value >= 0.95 And FRng.Offset(, -3).Value >= 0.95 Then '假如b.xlsx 這列的H欄的值大過或等於0.95

  21.            
  22.             Set Rng = Workbooks("outstanding payments").Sheets("outstanding payments").Range("a:a").Find(FRng.Offset(, -9), lookat:=xlWhole, SearchDirection:=xlPrevious)   ' 在a.xlsx 的A欄尋找b.xlsx 這列的B欄的值是否存在

  24.             If Rng Is Nothing Then             '假如找不到

  26.                 With Workbooks.Open("outstanding payments.xlsm").Sheets("outstanding payments")  '   在a.xlsx 的A欄最後一列加上b.xlsx 這列的B欄的值，及   在a.xlsx 的F欄最後一列加上b.xlsx 這列的K欄的值

  28.                     xi = .UsedRange.Cells(.UsedRange.Count).Row

  30.                     .UsedRange.Cells(xi, "A") = FRng.Offset(, -9).Value

  32.                     .UsedRange.Cells(xi, "F") = FRng.Value
  33.                   
  34.                 End With

  36.             End If

  38.         End If
  39.      
  40.     End If
  41. Wb.Close 0
  42. End Sub
  43.    
複製代碼
但是我現在連第一個都沒有反應，是不是程式有錯？
我把它的日期寫上當天，然後百份比填上100% ，照常理應該209514 會出現在outstanding payments sheet的A21儲存格上，但是沒有，是不是程式有錯？
209514        Argentia        MEIKE         7,936.50                         100.00%                        12/11        Lily Chan
作者: stillfish00    時間: 2012-12-12 00:55

本帖最後由 stillfish00 於 2012-12-12 00:57 編輯

回復 19# 198188
1. 你的code是放在哪個檔案?
2. 第22行:  Set Rng = Workbooks("outstanding payments").Sheets("outstanding payments").Range("a:a").Find(FRng.Offset(, -9), lookat:=xlWhole, SearchDirection:=xlPrevious)
     改outstanding payments.xlsm
3.  第26行:  With Workbooks.Open("outstanding payments.xlsm").Sheets("outstanding payments")
     改用完整路徑看看
4. 程式不如預期 , 可以學習下中斷點或逐行跑 , 搭配區域變數視窗&即時運算視窗 , debug會更有效率
作者: 198188    時間: 2012-12-12 09:11

回復 20# stillfish00


1. 你的code是放在哪個檔案?（程式放在outstanding payments.xlsm這個檔案,用payment report 2012裏面的資料來對比outstanding payments.xlsm這個檔案的內容。）
2. 第22行:  Set Rng = Workbooks("outstanding payments").Sheets("outstanding payments").Range("a:a").Find(FRng.Offset(, -9), lookat:=xlWhole, SearchDirection:=xlPrevious)
      改outstanding payments.xlsm
3.  第26行:  With Workbooks.Open("outstanding payments.xlsm").Sheets("outstanding payments")
     改用完整路徑看看（是不是With C:\user\destop\Workbooks.Open("outstanding payments.xlsm").Sheets("outstanding payments")?)
4.  搭配區域變數視窗&即時運算視窗 , debug會更有效率（是在哪個位置？）

由於我對語法運用不太熟悉，所以就算明白原理，但是不知道怎樣用程式語法表達，所以經常想不通。
比如要對比兩個檔案的資料，A.xlsx 和B.xlsx
程式是放在A.xlsx 裏面
同時要知道A.xlsx 和B.xlsx的最後一筆應該如何寫
sub ex()
Dim i as integer
Dim j as integer

workbooks(A.xlsx ).Worksheets("Sheet1").Range("A1").Select
ActiveCell.End(xlDown).Select
     i = ActiveCell.Row

fs = "Y:\2012\shipment 2012\B.xlsx"
Set wb = Workbooks.Open(fs)
wb.Worksheets("Sheet1").Range("A1").Select
ActiveCell.End(xlDown).Select
     j = ActiveCell.Row

另外一個是Dim 的運用

最後是
如何讓電腦識別那句語法是使用那個excel的資料

這三點如果明白用法，那我就明白如何解決這個問題。
作者: stillfish00    時間: 2012-12-12 11:05

本帖最後由 stillfish00 於 2012-12-12 11:07 編輯

回復 21# 198188
1. 程式放在outstanding payments.xlsm這個檔案
     表示  執行時outstanding payments.xlsm已經開啟
     那麼  26行 又用Workbooks.Open再開啟一次就沒有必要啦
3.  我原本的意思是改成With Workbooks.Open("C:\user\destop\outstanding payments.xlsm").Sheets("outstanding payments")
      但既然沒必要再開啟一次 ,
      改為With Workbooks("outstanding payments.xlsm").Sheets("outstanding payments")
      或省略為With Sheets("outstanding payments")就好了

同時要知道A.xlsx 和B.xlsx的最後一筆應該如何寫?
      寫法很多種 , 只舉例其中一種
      檔案已開啟的情況下A.xlsx的最後一筆
      With Workbooks("A.xlsx" ).Worksheets("Sheet1")    指定"A.xlsx"工作簿的"Sheet1"工作表
          Msgbox .Range("A" &  .rows.count).end(xlup).value
     End With
      A和B寫法是一模一樣 , 只是若你程式是寫在 A.xlsx 時
      Workbooks("A.xlsx" ).Worksheets("Sheet1")  可以省略成  Worksheets("Sheet1")
      Workbooks("B.xlsx" ).Worksheets("Sheet1")  則不能省略

如何讓電腦識別那句語法是使用那個excel的資料
      語法前的Workbooks("A.xlsx" )就是指定那個EXCEL
      如同你程式14行寫的Wb也是指定該EXCEL阿
作者: GBKEE    時間: 2012-12-12 11:07

回復 21# 198188
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i As Integer, j As Integer, fs As String
  4.     Dim Sh(1 To 2) As Worksheet
  5.     Set Sh(1) = Workbooks("A.xlsx").Worksheets("Sheet1")
  6.     i = Sh(1).Range("A1").End(xlDown).Row
  7.     Debug.Print i '印列在 即時運算視窗
  8.     fs = "Y:\2012\shipment 2012\B.xlsx"
  9.     Set Sh(2) = Workbooks.Open(fs).Worksheets("Sheet1")
  10.     j = Sh(2).Range("A1").End(xlDown).Row
  11.     Debug.Print j     '印列在 即時運算視窗
  12. End Sub
複製代碼
[attach]13499[/attach]
作者: 198188    時間: 2012-12-12 13:07

回復 22# stillfish00

我下面的寫法對嗎？
若程式是寫在 A.xlsx 時
Sub EX()
Dim i as integer
Dim j as integer
Worksheets("Sheet1")   
    i =  .Range("A" &  .rows.count).end(xlup).value    'i等於A.xlsx A欄的最後一筆

With Workbooks("B.xlsx" ).Worksheets("Sheet1")   
  j = .Range("A" &  .rows.count).end(xlup).value      'j等於A.xlsx A欄的最後一筆
      End With
End Sub


另外如果是最後一筆加1是不是這樣寫
Sub EX()
Dim i as integer
Dim j as integer
Worksheets("Sheet1")   
    i =  .Range("A" &  .rows.count).end(xlup).value  + 1  'i等於A.xlsx A欄的最後一筆加一

With Workbooks("B.xlsx" ).Worksheets("Sheet1")   
  j = .Range("A" &  .rows.count).end(xlup).value  + 1    'j等於A.xlsx A欄的最後一筆加一
      End With
End Sub
作者: stillfish00    時間: 2012-12-12 13:37

回復 24# 198188
不是 , 應該是
    i =  Worksheets("Sheet1").Range("A" &  Worksheets("Sheet1").rows.count).end(xlup).value  + 1
或寫成
   with Worksheets("Sheet1")   
      i =  .Range("A" &  .rows.count).end(xlup).value  + 1
   end with   


另外 .value  是儲存格內的值
.row才是列號(第幾列)
作者: 198188    時間: 2012-12-12 14:06

回復 25# stillfish00



  i =  Worksheets("Sheet1").Range("A" &  Worksheets("Sheet1").rows.count).end(xlup).value  + 1 是指最後一筆的儲存格值加1 （比如A100是最後一筆，而A100的值是3，那麼 i = 4)
  i =  Worksheets("Sheet1").Range("A" &  Worksheets("Sheet1").rows.count).end(xlup).row  + 1 是指最後一筆那列加1 （比如A100是最後一筆，那麼 i = 101)

請問是不是這個意思？
作者: stillfish00    時間: 2012-12-12 15:23

回復 26# 198188
對的
作者: 198188    時間: 2012-12-13 00:59

回復 27# stillfish00
  1. Option Explicit

  3. Sub ex()

  5.     Dim FRng As Range, Wb As Workbook

  7.     Dim A As Range, Rng As Range

  9.     Dim fs As String, xi As Integer
  10.     Dim i As Integer
  11.     Dim j As Integer
  12.     Dim k As Integer
  13.     i = Worksheets("outstanding payments").Range("A" & Worksheets("outstanding payments").Rows.Count).End(xlUp).Row
  14.     fs = "C:\Documents and Settings\USER\桌面\payment report 2012.xlsx"
  15.     Set Wb = Workbooks.Open(fs)
  16.    
  17.     With Worksheets("New form of payment report")
  18.       j = Worksheets("New form of payment report").Range("E" & Worksheets("New form of payment report").Rows.Count).End(xlUp).Row
  19.     End With
  20.    
  21.     Do
  22.         
  23.     If Wb.Worksheets("New form of payment report").Range("k" & j).Value = Date And Wb.Worksheets("New form of payment report").Range("h" & j).Value >= 0.95 Then
  24.    
  25.     If IsError(Application.VLookup(Wb.Worksheets("New form of payment report").Range("B" & j).Value, Worksheets("outstanding payments").Range("A:A"), 1, False)) Then
  26.    
  27.     Worksheets("outstanding payments").Range("A" & i + 1) = Wb.Worksheets("New form of payment report").Range("B" & j).Value
  28.     Worksheets("outstanding payments").Range("F" & i + 1) = Wb.Worksheets("New form of payment report").Range("H" & j).Value
  29.     End If
  30.      j = j - 1

  32.      i = i + 1
  33.     End If
  34.     Loop While j = 1
  35.    
  36.    Wb.Close 0
  37. End Sub
複製代碼
請問下面這句哪裡出錯了？ 執行階段錯誤‘9’：陣列索引超出範圍
If IsError(Application.VLookup(Wb.Worksheets("New form of payment report").Range("B" & j).Value, Worksheets("outstanding payments").Range("A:A"), 1, False)) Then
作者: stillfish00    時間: 2012-12-13 17:36

回復 28# 198188
最簡單的方法就是15行底下加上ThisWorkbook.Activate ,
或你都改成寫 ThisWorkBook.Worksheets("New form of payment report") 也可以
因為 Workbooks.Open 會改變當前作用中的活頁簿
我寫了code測試
  1. 'Codes In a.xlsm
  2. Sub test()    Dim wb, fstr As String
  3.     fstr = "C:/b.xlsm"
  4.    
  5.     Set wb = Workbooks.Open(fstr)  
  6.     Debug.Print ThisWorkbook.Name         'will print a.xlsm
  7.     Debug.Print ActiveWorkbook.Name     'will print b.xlsm
  8.     Debug.Print Sheets.Parent.Name           'will print b.xlsm
  9.     wb.Close 0
  10. End Sub
複製代碼
我發覺我前面(#22)說的好像也不完全正確
不是以Code寫在哪來區別能不能省略
應該更正為:
使用WorkSheets/Sheets語法前面沒指定活頁簿時 ,
會自動使用當時Active的活頁簿底下的WorkSheet
作者: 198188    時間: 2012-12-14 14:35

[/code][b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=48297&ptid=8531]29#[/url] [i]stillfish00[/i] [/b]
[code]Option Explicit

Sub ex()

    Dim FRng As Range, Wb As Workbook

    Dim A As Range, Rng As Range

    Dim fs As String, xi As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    i = Worksheets("outstanding payments").Range("A" & Worksheets("outstanding payments").Rows.Count).End(xlUp).Row
    fs = "C:\Users\patrick.HKG\Desktop\payment report 2012.xlsx"
    Set Wb = Workbooks.Open(fs)
   
   
   
    With Worksheets("New form of payment report")
      j = Worksheets("New form of payment report").Range("E" & Worksheets("New form of payment report").Rows.Count).End(xlUp).Row
   
    End With
   
    Do
   
    ThisWorkbook.Activate
   
    If Wb.Worksheets("New form of payment report").Range("k" & j).Value = Date And Wb.Worksheets("New form of payment report").Range("h" & j).Value >= 0.95 Then
   
    If IsError(Application.VLookup(Wb.Worksheets("New form of payment report").Range("B" & j).Value, Worksheets("outstanding payments").Range("A:A"), 1, False)) Then
   
    Worksheets("outstanding payments").Range("A" & i + 1) = Wb.Worksheets("New form of payment report").Range("B" & j).Value
    Worksheets("outstanding payments").Range("F" & i + 1) = Wb.Worksheets("New form of payment report").Range("K" & j).Value
    End If
    i = i + 1
    End If
    j = j - 1
   
   Loop While j = 2
   
   
   Wb.Close 0
End Sub


可以vlookup 出來了，但是只有最後一個？
DO
Loop While
這句是不是我寫錯了？
作者: 198188    時間: 2013-4-17 15:44

回復 23# GBKEE


    請問 With Worksheets("customer").Range(Cells(1, 11), Cells(12, e))這句是否有問題？我想將range設定不固定由A11開始到L欄最後一列畫框線
e = Worksheets("customer").Range("A" & Worksheets("customer").Rows.Count).End(xlUp).Row
With Worksheets("customer").Range(Cells(1, 11), Cells(12, e))
.Borders.LineStyle = 1

.Borders.LineStyle = 1

.Borders.ColorIndex = 0

.BorderAround , 2, 0
End With
作者: GBKEE    時間: 2013-4-17 16:45

回復 31# 198188
Cells(列數, 欄數)
   
With Worksheets("customer").Range(Cells(1, 11), Cells( e,12))
作者: 198188    時間: 2013-4-17 16:47

回復 32# GBKEE


    出現run-time error'9' subscript out of range
作者: GBKEE    時間: 2013-4-17 16:58

回復 33# 198188
你須學會程式碼的偵錯.
VBA視窗中,滑鼠移到有錯誤的程序,按F8逐行執行來看將,是那一行程式碼的發生錯誤.

[attach]14690[/attach]
作者: 198188    時間: 2013-4-17 17:00

回復 34# GBKEE


     e = Worksheets("customer").Range("A" & Worksheets("customer").Rows.Count).End(xlUp).Row
作者: GBKEE    時間: 2013-4-17 17:10

回復 35# 198188
Worksheets("customer") 這工作表找不到???
你程式碼所在的的專案(活頁簿)是與 Worksheets("customer")同一個活頁簿嗎???
如不是須指明(活頁簿)->   Workbooks ("???.XLS").Worksheets("customer").............
作者: 198188    時間: 2013-4-17 17:23

回復 36# GBKEE

With Worksheets(customer).Range(Cells(11, 1), Cells(e, 12))
    現在這句出現RUN-TIME ERROR '1004' APPLICATION-DEFINED OR OBJECT-DEFINED ERROR
作者: GBKEE    時間: 2013-4-17 17:41

本帖最後由 GBKEE 於 2013-4-17 17:42 編輯

回復 37# 198188

參考這裡
可能發生這個問題，如果有一個或多個儲存格 (儲存格範圍) 的陣列中包含設定為包含超過 911 個字元的字元字串。
作者: 198188    時間: 2013-4-17 17:45

回復 38# GBKEE


    我是用excel2010版，在同一個excel內create 一個新的sheets 然後在這個sheets畫框線
excel2010版是否也一樣？
作者: 198188    時間: 2013-4-17 17:54

  1. Sub Schedule()
  2.   Dim I As Double
  3.   Dim cnt As Double
  4.   Dim customer As String
  5.   Dim z As String
  6.   Dim a As Integer
  7.   Dim b As Integer
  8.   Dim c As Integer
  9.   Dim d As Integer
  10.   Dim e As Integer
  11.   Dim f As Integer
  12.   Dim m As Double
  13.   Dim FRng As Range
  14.   Dim Rng As Range
  15.   a = Worksheets("Oracle").Range("A" & Worksheets("Oracle").Rows.Count).End(xlUp).Row
  16.   b = Worksheets("Client Detial").Range("A" & Worksheets("Client Detial").Rows.Count).End(xlUp).Row
  17.   c = Worksheets("Rule").Range("A" & Worksheets("Rule").Rows.Count).End(xlUp).Row
  18. d = 1
  19. Do
  20.   cnt = 11
  21.    
  22.   z = Worksheets("Rule").Cells(d, 1).Value
  23.   customer = z
  24.   Worksheets("Form").Copy After:=Worksheets(Worksheets.Count)
  25.   
  26.   Worksheets(Worksheets.Count).Name = customer
  27.   Worksheets(customer).Range("J4").Value = Date

  29. For I = 2 To a
  30.   If Worksheets("Oracle").Cells(I, 5).Value = customer And Worksheets("Oracle").Cells(I, 20).Value <> 0 Then
  31.   Set FRng = Worksheets(customer).Range("B:B").Find(Worksheets("Oracle").Cells(I, 1).Value, lookat:=xlWhole, SearchDirection:=xlPrevious)
  32.   If FRng Is Nothing Then
  33.   Set Rng = Worksheets("Filter").Range("A:A").Find(Worksheets("Oracle").Cells(I, 1), lookat:=xlWhole)
  34.   If Rng Is Nothing Then
  35.   Worksheets(customer).Cells(cnt, 1).Value = Worksheets("Oracle").Cells(I, 7).Value
  36.   Worksheets(customer).Cells(cnt, 2).Value = Worksheets("Oracle").Cells(I, 1).Value
  37.   Worksheets(customer).Cells(cnt, 4).Value = Worksheets("Oracle").Cells(I, 24).Value
  38.   Worksheets(customer).Cells(cnt, 5).Value = Worksheets("Oracle").Cells(I, 14).Value
  39.   Worksheets(customer).Cells(cnt, 6).Value = Worksheets("Oracle").Cells(I, 12).Value
  40.   Worksheets(customer).Cells(cnt, 7).Value = Worksheets("Oracle").Cells(I, 26).Value
  41.   Worksheets(customer).Cells(cnt, 8).Value = Worksheets("Oracle").Cells(I, 41).Value
  42.   Worksheets(customer).Cells(cnt, 9).Value = Split(Worksheets("Oracle").Cells(I, 42).Value, "/")(0)
  43.   Worksheets(customer).Cells(cnt, 10).Value = Worksheets("Oracle").Cells(I, 27).Value
  44.   Worksheets(customer).Cells(cnt, 11).Value = Worksheets("Oracle").Cells(I, 28).Value
  45.   Worksheets(customer).Cells(cnt, 13).Value = Worksheets("Oracle").Cells(I, 20).Value
  46.   Worksheets(customer).Cells(cnt, 14).Value = Worksheets("Oracle").Cells(I, 18).Value
  47.   Worksheets(customer).Cells(cnt, 15).Value = Worksheets("Oracle").Cells(I, 2).Value
  48.   Worksheets(customer).Cells(cnt, 16).Value = Worksheets("Oracle").Cells(I, 60).Value
  49.   If Trim(Worksheets("Oracle").Cells(I, 8).Value) = "" Then
  50.   Worksheets(customer).Cells(cnt, 3).Value = "NO"
  51.   Else
  52.   Worksheets(customer).Cells(cnt, 3).Value ="YES"
  53.   End If
  54.   cnt = cnt + 1
  55.    End If
  56.    End If
  57.   End If
  58.   
  59.   If Worksheets("Oracle").Cells(I, 5).Value = customer And Trim(Worksheets("Oracle").Cells(I, 20).Value) = "" Then
  60.   Set FRng = Worksheets(customer).Range("B:B").Find(Worksheets("Oracle").Cells(I, 1).Value, lookat:=xlWhole, SearchDirection:=xlPrevious)
  61.   If FRng Is Nothing Then
  62.   Set Rng = Worksheets("Filter").Range("A:A").Find(Worksheets("Oracle").Cells(I, 1), lookat:=xlWhole)
  63.   If Rng Is Nothing Then
  64.   Worksheets(customer).Cells(cnt, 1).Value = Worksheets("Oracle").Cells(I, 7).Value
  65.   Worksheets(customer).Cells(cnt, 2).Value = Worksheets("Oracle").Cells(I, 1).Value
  66.   Worksheets(customer).Cells(cnt, 4).Value = Worksheets("Oracle").Cells(I, 24).Value
  67.   Worksheets(customer).Cells(cnt, 5).Value = Worksheets("Oracle").Cells(I, 14).Value
  68.   Worksheets(customer).Cells(cnt, 6).Value = Worksheets("Oracle").Cells(I, 12).Value
  69.   Worksheets(customer).Cells(cnt, 7).Value = Worksheets("Oracle").Cells(I, 26).Value
  70.   Worksheets(customer).Cells(cnt, 8).Value = Worksheets("Oracle").Cells(I, 41).Value
  71.   Worksheets(customer).Cells(cnt, 10).Value = Worksheets("Oracle").Cells(I, 27).Value
  72.   Worksheets(customer).Cells(cnt, 11).Value = Worksheets("Oracle").Cells(I, 28).Value
  73.   Worksheets(customer).Cells(cnt, 13).Value = Worksheets("Oracle").Cells(I, 20).Value
  74.   Worksheets(customer).Cells(cnt, 14).Value = Worksheets("Oracle").Cells(I, 18).Value
  75.   Worksheets(customer).Cells(cnt, 15).Value = Worksheets("Oracle").Cells(I, 2).Value
  76.   Worksheets(customer).Cells(cnt, 16).Value = Worksheets("Oracle").Cells(I, 60).Value
  77.   If Trim(Worksheets("Oracle").Cells(I, 8).Value) = "" Then
  78.   Worksheets(customer).Cells(cnt, 3).Value = "NO"
  79.   Else
  80.   Worksheets(customer).Cells(cnt, 3).Value = "YES"
  81.   End If
  82.   If Trim(Worksheets("Oracle").Cells(I, 42).Value) = "" Then
  83.   Worksheets(customer).Cells(cnt, 9).Value = ""
  84.   Else
  85.   Worksheets(customer).Cells(cnt, 9).Value = Split(Worksheets("Oracle").Cells(I, 42).Value, "/")(0)
  86.   End If
  87.   cnt = cnt + 1
  88.    End If
  89.    End If
  90.    End If
  91.    
  92.   If Worksheets("Oracle").Cells(I, 5).Value = customer And Worksheets("Oracle").Cells(I, 20).Value = 0 And Worksheets("Oracle").Cells(I, 28).Value >= Date Then
  93.   Set FRng = Worksheets(customer).Range("B:B").Find(Worksheets("Oracle").Cells(I, 1).Value, lookat:=xlWhole, SearchDirection:=xlPrevious)
  94.   If FRng Is Nothing Then
  95.   Set Rng = Worksheets("Filter").Range("A:A").Find(Worksheets("Oracle").Cells(I, 1), lookat:=xlWhole)
  96.   If Rng Is Nothing Then
  97.   Worksheets(customer).Cells(cnt, 1).Value = Worksheets("Oracle").Cells(I, 7).Value
  98.   Worksheets(customer).Cells(cnt, 2).Value = Worksheets("Oracle").Cells(I, 1).Value
  99.   Worksheets(customer).Cells(cnt, 4).Value = Worksheets("Oracle").Cells(I, 24).Value
  100.   Worksheets(customer).Cells(cnt, 5).Value = Worksheets("Oracle").Cells(I, 14).Value
  101.   Worksheets(customer).Cells(cnt, 6).Value = Worksheets("Oracle").Cells(I, 12).Value
  102.   Worksheets(customer).Cells(cnt, 7).Value = Worksheets("Oracle").Cells(I, 26).Value
  103.   Worksheets(customer).Cells(cnt, 8).Value = Worksheets("Oracle").Cells(I, 41).Value
  104.   Worksheets(customer).Cells(cnt, 9).Value = Split(Worksheets("Oracle").Cells(I, 42).Value, "/")(0)
  105.   Worksheets(customer).Cells(cnt, 10).Value = Worksheets("Oracle").Cells(I, 27).Value
  106.   Worksheets(customer).Cells(cnt, 11).Value = Worksheets("Oracle").Cells(I, 28).Value
  107.   Worksheets(customer).Cells(cnt, 13).Value = Worksheets("Oracle").Cells(I, 20).Value
  108.   Worksheets(customer).Cells(cnt, 14).Value = Worksheets("Oracle").Cells(I, 18).Value
  109.   Worksheets(customer).Cells(cnt, 15).Value = Worksheets("Oracle").Cells(I, 2).Value
  110.   Worksheets(customer).Cells(cnt, 16).Value = Worksheets("Oracle").Cells(I, 60).Value
  111.   If Trim(Worksheets("Oracle").Cells(I, 18).Value) <> "" Then Worksheets(customer).Cells(cnt, 12).Value = "眒葆遴"
  112.   If Trim(Worksheets("Oracle").Cells(I, 8).Value) = "" Then
  113.   Worksheets(customer).Cells(cnt, 3).Value = "NO"
  114.   Else
  115.   Worksheets(customer).Cells(cnt, 3).Value = "YES"
  116.   End If
  117.   cnt = cnt + 1
  118.    End If
  119.    End If
  120.    End If
  121.   Next I

  123. For I = 2 To b
  124. If Worksheets("Client Detial").Cells(I, 1).Value = customer Then
  125. Worksheets(customer).Cells(5, 3).Value = Worksheets("Client Detial").Cells(I, 4).Value & " - " & Worksheets("Client Detial").Cells(I, 5).Value
  126. Worksheets(customer).Cells(6, 3).Value = Worksheets("Client Detial").Cells(I, 8).Value
  127. End If
  128. Next I

  130. e = Worksheets(customer).Range("A" & Worksheets(customer).Rows.Count).End(xlUp).Row

  132. With Worksheets(customer).Range(Cells(11, 1), Cells(e, 12))

  134. .Borders.LineStyle = 1

  136. .Borders.LineStyle = 1

  138. .Borders.ColorIndex = 0

  140. .BorderAround , 2, 0
  141. End With

  143. d = d + 1
  144. Loop Until d > c
  145. End Sub
複製代碼
回復 38# GBKEE

如果我合在一起運行就會出現那問題，但是如果我將下面這段分開另外一個獨立的程式，就沒有問題
e = Worksheets(customer).Range("A" & Worksheets(customer).Rows.Count).End(xlUp).Row

With Worksheets(customer).Range(Cells(11, 1), Cells(e, 12))

.Borders.LineStyle = 1

.Borders.LineStyle = 1

.Borders.ColorIndex = 0

.BorderAround , 2, 0
End With
作者: GBKEE    時間: 2013-4-17 18:04

回復 40# 198188
試試看
  1. With Worksheets(customer)
  2.     With .Range(.Cells(11, 1), .Cells(e, 12))
  3.         .Borders.LineStyle = 1
  4.         .Borders.LineStyle = 1
  5.         .Borders.ColorIndex = 0
  6.         .BorderAround , 2, 0
  7.     End With
  8. End With
複製代碼
作者: 198188    時間: 2013-4-18 09:10

回復 41# GBKEE

感謝大大幫忙！
請問可否幫我看看下面LINK的問題？
    http://forum.twbts.com/viewthrea ... amp;page=2#pid52598
作者: GBKEE    時間: 2013-4-18 15:00

回復 42# 198188
不好意思:2003開啟此2010活頁簿因有太多格式,導致不能正常開啟此活頁簿
可否另存2003版加上問題的說明上傳
作者: 198188    時間: 2013-4-18 16:32

[attach]14699[/attach]回復 43# GBKEE



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