- 帖子
- 43
- 主題
- 13
- 精華
- 0
- 積分
- 75
- 點名
- 0
- 作業系統
- windows 7
- 軟體版本
- office 2007
- 閱讀權限
- 20
- 註冊時間
- 2014-5-6
- 最後登錄
- 2019-6-17
|
回復 11# GBKEE
感謝GBKEE前輩指導兩個方法、讓小弟可以有多一層空間變化,
不好意思如果小弟套用的來源端屬於不同excel、
故使用以下方式進行設定、但似乎漏了哪個環節而導致無法執行,
因嘗試許久無法正解、請問能不能再請幫忙看一下呢?
find 與比對Range 問題1.zip (25.65 KB)
程式碼:
Sub Ex3()
Dim Rng(1 To 2) As Range, Rng2_Address As String
Dim wb(1 To 2) As Workbook
Dim myApp As New Application
Set wb(1) = ThisWorkbook '使用於sheet(比對data)
Set wb(2) = myApp.Workbooks.Open(Worksheets("路徑區").Cells(2, 3) & "\" & Worksheets("路徑區").Cells(2, 2)) '使用於另一個excel sheet(來源data)
Set Rng(1) = wb(1).Worksheets("比對data").Range("A2") '比對data的第一筆資料(日期)
Do While Rng(1) <> "" '執行到條件不成立
With wb(2).Sheets("來源data").Range("A:A") '範圍:這工作表的A欄
Set Rng(2) = .Find(Rng(1), AFTER:=.Cells(1), LookIn:=xlFormulas) '搜尋日期:要用公式LookIn:=xlFormulas
Do While Not Rng(2) Is Nothing '執行到條件不成立
If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '記錄第一次找到的位置
If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) Then '
' Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3) '比對的第二欄=來源data的第二欄
Rng(1).Cells(1, 3) = Rng(2).Row '此段為找該資料的row
Exit Do
End If
Set Rng(2) = .FindNext(Rng(2)) '繼續往下搜尋
If Rng2_Address = Rng(2).Address Then '回到第一次找到的位置
Exit Do '離開迴圈
End If
Loop
Rng2_Address = ""
Set Rng(1) = Rng(1).Offset(1) '比對data的下一筆資料(日期)
End With
Loop
wb(2).Close False
Set wb(1) = Nothing
Set wb(2) = Nothing
Set Rng(1) = Nothing: Set Rng(2) = Nothing
' Set findvalue = Nothing
End Sub |
|