返回列表 上一主題 發帖

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

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

不好意思、請問前輩一下~小弟有一份資料情況如下:
1.比對data   2.來源data  3.總整理

資料為使用vba尋找"比對data"最後一筆的("A~D")的資料,
去核對sheet"來源data"中("A~D")的資料如果有完全相符的就從sheet"來源data"中將該列的資料copy到sheet"總整理"。
因小弟使用Find、但卻卡在這次需尋找是一個區塊而非單一字串或儲存格內容,
所以請前輩能不能指導一下小弟接下來該如何改寫?

感謝~

find 與比對Range 後將欄位copy到某欄 .rar (16.33 KB)

回復 1# ii31sakura
試試看
  1. Sub Ex()
  2.     Dim Ar(), i As Integer, S As String
  3.     With Sheets("比對data").Range("A" & Sheets("比對data").Rows.Count).End(xlUp).Resize(, 4)
  4.         S = Join(Application.Transpose(Application.Transpose(.Value)), "")
  5.         '"比對data"最後一筆的("A~D")的資料
  6.     End With
  7.     With Sheets("總整理")
  8.         .Cells.Clear
  9.         .Range("A1").Resize(, 7) = Sheets("來源data").Range("A1").Resize(, 7).Value     '表頭
  10.         Ar = Sheets("來源data").Range("A1:D5").Value  'sheet"來源data"中("A~D")
  11.         For i = 1 To UBound(Ar)
  12.             If S = Join(Application.Index(Ar, i), "") Then
  13.                 .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, 7) = _
  14.                     Sheets("來源data").Cells(i, "A").Resize(, 7).Value
  15.             End If
  16.         Next
  17.     End With
  18. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE

感謝GBKEE前輩~不好意思再請問一下、小弟如果想知道完全相符的(來源data)是第幾欄位,
如果直接輸入(msgbox s) 則會顯示{("A~D")的資料}內容、如果輸入(msgbox s.address 或 msgbox s row)都顯示"不正確的定位項,
請問小弟該輸入些什麼呢?

TOP

回復 3# ii31sakura
  1. Sub Ex()
  2.     Dim Ar(), i As Integer, S As String, Rng As Range, ss
  3.     With Sheets("比對data").Range("A" & Sheets("比對data").Rows.Count).End(xlUp).Resize(, 4)
  4.         S = Join(Application.Transpose(Application.Transpose(.Value)), "")
  5.         '"比對data"最後一筆的("A~D")的資料
  6.     End With
  7.     With Sheets("總整理")
  8.         .Cells.Clear
  9.         .Range("A1").Resize(, 7) = Sheets("來源data").Range("A1").Resize(, 7).Value     '表頭
  10.         Ar = Sheets("來源data").Range("A1:D5").Value  'sheet"來源data"中("A~D")
  11.         For i = 1 To UBound(Ar)
  12.             If S = Join(Application.Index(Ar, i), "") Then
  13.                 Set Rng = Sheets("來源data").Cells(i, "A").Resize(, 7)
  14.                 MsgBox "在 第" & i & " 列  找到 " & Join(Application.Transpose(Application.Transpose(Rng.Value)), ",")
  15.                 .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, 7) = Rng.Value
  16.             End If
  17.         Next
  18.     End With
  19. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE

不好意思、GBKEE前輩可否再請指導一下,
如果來源data資料列位超過比對data列位、請問可從哪邊修改_可比對來源data到最後呢?

註:小弟有將附件內容修改一下(比對data只到第5列、來源data到第5列之後就無法進行比對動作)
   
可否請麻煩一下~
find 與比對Range 後將欄位copy到某欄 .rar (18.02 KB)

TOP

回復 6# ii31sakura
修改為 R => 由A欄最底部往上到有資料儲存格的列號
  1. 'Ar = Sheets("來源data").Range("A1:D5").Value  'sheet"來源data"中("A~D")
  2.         With Sheets("來源data")
  3.             R = .Cells(.Rows.Count, "a").End(xlUp).Row
  4.             Ar = .Range("A1:D" & R).Value 'sheet"來源data"中("A~D")
  5.         End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 ii31sakura 於 2014-8-16 14:51 編輯

回復 6# GBKEE

不好意思、GBKEE前輩請問一下因小弟使用範例(ex1)可以正確找到想要的答案(比對data最後A&B 兩個儲存格在於來源data屬於哪個row),
但因小弟將範例用於data筆數破萬時發現執行較久,
故想請問是不是有像(ex2)的Find方式可以尋找正確的答案row在何處呢或是請問(ex1)可指點如何修改呢??

註:
因ex2中小弟使用 Union將來源data需比較的兩欄放一起想用Find找兩個條件,但實際上還是無法實現我想要的答案(如ex1所能正確的找出第幾列)、
能不能懇請幫忙一下~
   
find 與比對Range 問題1.zip (18.04 KB)

Sub ex2()
    Dim range1 As Range, range2 As Range, range3 As Range, range4 As Range
    Dim allrange As Range, allrange1 As Range, c As Integer

   
b = Worksheets("比對data").[b65536].End(3).Row
c = Worksheets("來源data").[b65536].End(3).Row
   
Set range1 = Sheets("來源data").Range("A" & 2 & ":" & "A" & c)
Set range2 = Sheets("來源data").Range("b" & 2 & ":" & "b" & c)
Set allrange = Union(range1, range2)



          '此區塊為先找row
         Set findvalue = allrange.Find(What:=Worksheets("比對data").Cells(b, 2))  '←此種只能找尋單一儲存格,請問是否能實現下一段備註情況,可以找兩條件呢?
'Set findvalue = allrange.Find(What:=Worksheets("比對data").Cells(b, 1) & Worksheets("比對data").Cells(b, 2)) '問題點(有方法可正確使兩個儲存格的條件都可找到嗎?此段請問能否指點小弟該如何修改呢?)
          MsgBox findvalue.Row


    Set range1 = Nothing: Set range2 = Nothing: Set allrange = Nothing: Set findvalue = Nothing



End Sub

TOP

回復 7# ii31sakura
試試看
  1. Option Explicit
  2. Sub Ex2()
  3.     Dim Rng(1 To 2) As Range, Rng2_Address As String
  4.     Set Rng(1) = Worksheets("比對data").Range("A2")                    '比對data的第一筆資料(日期)
  5.     Do While Rng(1) <> ""                                              '執行到條件不成立
  6.         With Sheets("來源data").Range("A:A")                           '範圍:這工作表的A欄
  7.             Set Rng(2) = .Find(Rng(1), AFTER:=.Cells(1), LookIn:=xlFormulas) '搜尋日期:要用公式LookIn:=xlFormulas
  8.             Do While Not Rng(2) Is Nothing                              '執行到條件不成立
  9.                 If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '記錄第一次找到的位置
  10.                 If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) Then     '
  11.                     Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3)             '比對的第二欄=來源data的第二欄
  12.                     Exit Do
  13.                 End If
  14.                 Set Rng(2) = .FindNext(Rng(2))                          '繼續往下搜尋
  15.                 If Rng2_Address = Rng(2).Address Then                   '回到第一次找到的位置
  16.                     Exit Do                                             '離開迴圈
  17.                 End If
  18.             Loop
  19.             Rng2_Address = ""
  20.             Set Rng(1) = Rng(1).Offset(1)                               '比對data的下一筆資料(日期)
  21.         End With
  22.     Loop
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 8# GBKEE

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

TOP

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

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題