[發問] 請問各位前輩關於Find 與比對Range 問題

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

16^#

發表於 2014-8-19 19:11 | 只看該作者

回復 13# GBKEE

GBKEE前輩~不好意思…後來小弟嘗試在開啟檔案前加上"Application.DisplayAlerts = False '關閉所有EXCEL程序系統提示"之後就可以正常值行了，
真是不好意思這麼麻煩您。

感謝前輩前幾段的指導~

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

15^#

發表於 2014-8-19 17:05 | 只看該作者

回復 13# GBKEE

不好意思 GBKEE前輩，因小弟工作關係需套用於別處、請問如果來源資料wb(2)開起時出現如下圖的( 無法更新的連結)，
請問該如何將來源資料的自動更新關閉呢？

註：小弟爬文嘗試使用語句2來關閉來源資料警告、但可能卡在語句1已經先開啟，所以總是出現錯誤情況。

語句1： Set wb(2) = Workbooks.Open(Worksheets("路徑區").Cells(2, 3) & "\" & Worksheets("路徑區").Cells(2, 2)) '使用於另一個excel sheet(來源data)
語句2：Workbooks.Open Filename:="D:\週別資料\wk1432\find 比對問題\find 與比對Range 問題3 - 來源data.xlsm" ,UpdateLinks:=0

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

14^#

發表於 2014-8-19 12:13 | 只看該作者

回復 13# GBKEE

感謝GBKEE前輩指導、因為小弟的資料來源大多為區網上的共用excel data，
會使用例子1因擔心可能來源data已先被其它人開啟會有開啟警告問題，
經前輩提醒後、小弟實際去測試使用例子2、即使有人開起來源data也似乎不影響程式的運行，
在此謝謝前輩的指導囉~

例子1：' Dim myApp As New Application '為何要新開 Excel
例子2：Set wb(2) = Workbooks.Open

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

13^#

發表於 2014-8-19 10:41 | 只看該作者

回復 12# ii31sakura

Dim myApp As New Application
With wb(2).Sheets("來源data").Range("A:A") '範圍:這工作表的A欄
Set Rng(2) = .Find(Rng(1).Value, AFTER:=.Cells(1), LookIn:=xlFormulas) '搜尋日期:要用公式LookIn:=xlFormulas

複製代碼

Rng(2) is nothing 無法突破

試試不新開 Excel 應用程式

Sub Ex3()
Dim Rng(1 To 3) As Range, Rng2_Address As String
Dim wb(1 To 2) As Workbook
' Dim myApp As New Application '為何要新開 Excel
Set wb(1) = ThisWorkbook '使用於sheet(比對data)
'Set wb(2) = myApp.Workbooks.Open(Worksheets("路徑區").Cells(2, 3) & "\" & Worksheets("路徑區").Cells(2, 2)) '使用於另一個excel sheet(來源data)
Set wb(2) = 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).Value, 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
'******************
If Rng(3) Is Nothing Then
Set Rng(3) = Rng(2).Resize(, 3)
Else
Set Rng(3) = Union(Rng(3), Rng(2).Resize(, 3))
End If
'*********************
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
If Not Rng(3) Is Nothing Then
With wb(1).Worksheets("總整理")
.UsedRange.Offset(1) = ""
Rng(3).Copy .Range("A2")
End With
End If
wb(2).Close False
Set wb(1) = Nothing
Set wb(2) = Nothing
Set Rng(1) = Nothing
Set Rng(2) = Nothing
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

12^#

發表於 2014-8-18 21:54 | 只看該作者

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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

11^#

發表於 2014-8-18 19:49 | 只看該作者

回復 10# ii31sakura

Option Explicit
Sub Ex()
Dim d As Object, Rng As Range, S As String
Set d = CreateObject("scripting.dictionary")
Set Rng = Sheets("比對data").Range("A2")
Do While Rng <> ""
d(Rng & Rng.Cells(1, 2) & Rng.Cells(1, 3)) = ""
Set Rng = Rng.Cells(2, 1)
Loop
Set Rng = Sheets("來源data").Range("A2")
Do While Rng <> ""
If d.EXISTS(Rng & Rng.Cells(1, 2) & Rng.Cells(1, 3)) Then
If d.EXISTS("比對到") Then
Set d("比對到") = Union(Rng.Resize(, 3), d("比對到"))
Else
Set d("比對到") = Rng.Resize(, 3)
End If
S = IIf(S <> "", S & vbLf, "") & Rng.Address(0, 0) & " 找到 " & Rng & "-" & Rng.Cells(1, 2) & "-" & Rng.Cells(1, 3)
End If
Set Rng = Rng.Cells(2, 1)
Loop
If S <> "" Then
d("比對到").Parent.Activate
d("比對到").Select
MsgBox "來源data " & vbLf & S
End If
End Sub
Sub Ex3()
Dim Rng(1 To 2) As Range, Rng2_Address As String
Set Rng(1) = Worksheets("比對data").Range("A2") '比對data的第一筆資料(日期)
Sheets("來源data").UsedRange.Offset(1).Interior.ColorIndex = xlNone
Do While Rng(1) <> "" '執行到條件不成立
With 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) And Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3) Then '
' Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3) '比對的第二欄=來源data的第二欄
Rng(1).Cells(1, 4) = Rng(2).Row '此段為找該資料的row
Rng(2).Resize(, 3).Interior.Color = vbYellow
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
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

10^#

發表於 2014-8-18 15:25 | 只看該作者

回復 8# GBKEE

抱歉、GBKEE前輩…能否再請指導附檔中如果比對條件能否從兩個比對條件變更為三個比對條件呢？
因小弟另一個檔案發現兩個比對條件可能會碰到重覆性情況、如果使用三個比對條件就不會有重覆情況，
能否請問可於何處進行修改呢？
不好意思了...

find 與比對Range 問題1.rar (18.02 KB)

Sub Ex3()
Dim Rng(1 To 2) As Range, Rng2_Address As String
Set Rng(1) = Worksheets("比對data").Range("A2")                   '比對data的第一筆資料(日期)
Do While Rng(1) <> ""                                           '執行到條件不成立
      With 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, 4) = 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
End Sub

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

9^#

發表於 2014-8-16 23:04 | 只看該作者

回復 8# GBKEE

非常感謝GBKEE前輩~真是佛心來的，前輩還幫忙每段用註解、真感謝~

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2014-8-16 16:38 | 只看該作者

回復 7# ii31sakura
試試看

Option Explicit
Sub Ex2()
Dim Rng(1 To 2) As Range, Rng2_Address As String
Set Rng(1) = Worksheets("比對data").Range("A2") '比對data的第一筆資料(日期)
Do While Rng(1) <> "" '執行到條件不成立
With 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的第二欄
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
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.