198188

回復 38# GBKEE

下載 (49.03 KB)

2012-12-13 14:19

    另外請問可否在excel 的EDIT FORMATING RULE設定
在A欄設定如果B欄是值大過0 和不等於A欄就變顏色

198188

回復 38# GBKEE

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.     With Worksheets("New form of payment report")
    
13.       j = Worksheets("New form of payment report").Range("E" & Worksheets("New form of payment report").Rows.Count).End(xlUp).Row
    
14.     End With
    
15.    Do
    
16.     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   
    
17.     If IsError(Application.VLookup(Wb.Worksheets("New form of payment report").Range("B" & j).Value, Worksheets("outstanding payments").Range("A:A"), 1, False)) Then   
    
18.     Worksheets("outstanding payments").Range("A" & i + 1) = Wb.Worksheets("New form of payment report").Range("B" & j).Value
    
19.     Worksheets("outstanding payments").Range("F" & i + 1) = Wb.Worksheets("New form of payment report").Range("H" & j).Value
    
20.     End If
    
21.      j = j - 1
    
22.      i = i + 1
    
23.     End If
    
24.     Loop While j = 1   
    
25.    Wb.Close 0
    
26. End Sub

複製代碼

那麼是不是要在worksheets前面加上workbooks?但是上一句名稱沒有問題？

198188

回復 38# GBKEE

第38貼
  請問可否在excel 的EDIT FORMATING RULE設定
在A欄設定：如果B欄是值大過0 和不等於A欄就變顏

198188

回復 41# GBKEE

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:\Users\patrick.HKG\Desktop\payment report 2012.xlsx"
    
11.     Set Wb = Workbooks.Open(fs)   
    
12.     With Worksheets("New form of payment report")
    
13.       j = Worksheets("New form of payment report").Range("E" & Worksheets("New form of payment report").Rows.Count).End(xlUp).Row   
    
14.     End With   
    
15.     Do   
    
16.     ThisWorkbook.Activate   
    
17.     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   
    
18.     If IsError(Application.VLookup(Wb.Worksheets("New form of payment report").Range("B" & j).Value, Worksheets("outstanding payments").Range("A:A"), 1, False)) Then   
    
19.     Worksheets("outstanding payments").Range("A" & i + 1) = Wb.Worksheets("New form of payment report").Range("B" & j).Value
    
20.     Worksheets("outstanding payments").Range("F" & i + 1) = Wb.Worksheets("New form of payment report").Range("K" & j).Value
    
21.     End If
    
22.     i = i + 1
    
23.     End If
    
24.     j = j - 1   
    
25.    Loop While j = 2  
    
26.    
    
27.    Wb.Close 0
    
28. End Sub

複製代碼

請問
Do
Loop While
是不是寫錯了？他不懂得循環做

198188

回復 3# GBKEE

高人，可否幫我看看個程式問題？
    http://forum.twbts.com/viewthrea ... amp;page=2#pid51122