返回列表 上一主題 發帖

請幫忙翻譯一下程式

回復 18# stillfish00
  1. Option Explicit

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

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

  9.     Set Wb = Workbooks.Open(fs)

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

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

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

  14.            
  15.             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欄的值是否存在

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

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

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

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

  20.                     .UsedRange.Cells(xi, "F") = FRng.Value
  21.                   
  22.                 End With

  23.             End If

  24.         End If
  25.      
  26.     End If
  27. Wb.Close 0
  28. End Sub
  29.    
複製代碼
但是我現在連第一個都沒有反應,是不是程式有錯?
我把它的日期寫上當天,然後百份比填上100% ,照常理應該209514 會出現在outstanding payments sheet的A21儲存格上,但是沒有,是不是程式有錯?
209514        Argentia        MEIKE         7,936.50                         100.00%                        12/11        Lily Chan

TOP

回復 20# stillfish00


1. 你的code是放在哪個檔案?(程式放在outstanding payments.xlsm這個檔案,用payment report 2012�堶悸爾禤い蚢鴾隳utstanding 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的資料

這三點如果明白用法,那我就明白如何解決這個問題。

TOP

回復 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

TOP

回復 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)

請問是不是這個意思?

TOP

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

  27.      i = i + 1
  28.     End If
  29.     Loop While j = 1
  30.    
  31.    Wb.Close 0
  32. 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

TOP

[/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
這句是不是我寫錯了?

TOP

回復 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

TOP

回復 32# GBKEE


    出現run-time error'9' subscript out of range

TOP

回復 34# GBKEE


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

TOP

回復 36# GBKEE

With Worksheets(customer).Range(Cells(11, 1), Cells(e, 12))
    現在這句出現RUN-TIME ERROR '1004' APPLICATION-DEFINED OR OBJECT-DEFINED ERROR

TOP

        靜思自在 : 能善用時間的人,必能掌握自己努力的方向。
返回列表 上一主題