請問VBA尋找使用方法

ginbow

想請問一下 如何使用多重條件尋找  如附檔

條件式 A欄和B欄都符合 才把C蘭的直抓進來

這樣的話也可以用Vooklup 或是 find 嗎?

register313

回復 1# ginbow

1. Sub xx()
   
2. Dim AR()
   
3. I = 1
   
4. For Each A In Range("A2:A" & [A2].End(xlDown).Row)
   
5.   ReDim Preserve AR(1 To I)
   
6.   If A = "2011/12/7" And A.Offset(0, 1) = 3 Then
   
7.      AR(I) = A.Offset(0, 2)
   
8.      I = I + 1
   
9.   End If
   
10. Next
    
11. [E1].Resize(UBound(AR), 1) = Application.Transpose(AR)
    
12. End Sub

複製代碼

1. Sub bb()
   
2. Set Rng = Range("A1:C" & Range("A65536").End(xlUp).Row)
   
3. Rng.AutoFilter Field:=1, Criteria1:=DateValue("2011/12/7")
   
4. Rng.AutoFilter Field:=2, Criteria1:=3
   
5. Rng.Offset(0, 2).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy [E1]
   
6. Rng.AutoFilter
   
7. End Sub

複製代碼

1. Sub cc()
   
2. [E:E] = ""
   
3. Set Rng = [A:A].Find(DateValue("2011/12/7"), , , xlWhole)
   
4. If Not Rng Is Nothing Then
   
5.    S = Rng.Address
   
6.    Do
   
7.      If Rng.Offset(0, 1) = 3 Then [E65536].End(xlUp).Offset(1, 0) = Rng.Offset(0, 2)
   
8.      Set Rng = [A:A].FindNext(Rng)
   
9.    Loop While Not Rng Is Nothing And Rng.Address <> S
   
10. End If
    
11. End Sub

複製代碼

ginbow

謝謝 我稍微改了一下 可是不知道為什麼抓不到

可以幫我看一下哪裡出錯嗎 謝謝

register313

回復 3# ginbow

1. Sub data()
   
2. nrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row
   
3. With Worksheets("sheet2").Range("A1:D" & Worksheets("sheet2").Range("A65536").End(xlUp).Row)
   
4.   For i = 2 To nrow
   
5.     .AutoFilter Field:=1, Criteria1:=DateValue(Worksheets("sheet1").Cells(i, 1))
   
6.     .AutoFilter Field:=2, Criteria1:=Worksheets("sheet1").Cells(i, 8)
   
7.     .AutoFilter Field:=3, Criteria1:=Worksheets("sheet1").Cells(i, 3)
   
8.     .AutoFilter Field:=4, Criteria1:="買權"
   
9.     .Offset(1, 4).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Worksheets("選擇權資料").Cells(i, 1)
   
10.   Next
    
11.   .AutoFilter
    
12. End With
    
13. End Sub

複製代碼

ginbow

回復 4# register313


        謝謝你已經修改成我要的格式了 想另外請問一下   我是用你所提出來的第二個方法      但怕資料量多時效率會比較慢
      上面三種方法哪一種效率會比較快呢?

register313

回復 5# ginbow

1. Sub 字典()
   
2. t = Timer
   
3. Application.ScreenUpdating = False
   
4. Set d = CreateObject("scripting.dictionary")
   
5. With Worksheets("sheet1")
   
6.   AR = .[A1].CurrentRegion
   
7.   For i = 2 To UBound(AR)
   
8.     d(AR(i, 1) & AR(i, 8) & AR(i, 3) & "買權") = ""
   
9.   Next i
   
10. End With
    
11. With Worksheets("sheet2")
    
12.   BR = .[A1].CurrentRegion
    
13.   For i = 2 To UBound(BR)
    
14.     If d.Exists(BR(i, 1) & BR(i, 2) & BR(i, 3) & BR(i, 4)) Then d(BR(i, 1) & BR(i, 2) & BR(i, 3) & BR(i, 4)) = BR(i, 5)
    
15.   Next
    
16. End With
    
17. Worksheets("選擇權資料").[A2].Resize(d.Count, 1) = Application.Transpose(d.items)
    
18. Application.ScreenUpdating = True
    
19. MsgBox Timer - t & "秒"
    
20. End Sub

複製代碼

1. Sub 自動篩選()
   
2. t = Timer
   
3. Application.ScreenUpdating = False
   
4. nrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row
   
5. With Worksheets("sheet2").Range("A1:D" & Worksheets("sheet2").Range("A65536").End(xlUp).Row)
   
6.   For i = 2 To nrow
   
7.     .AutoFilter Field:=1, Criteria1:=DateValue(Worksheets("sheet1").Cells(i, 1))
   
8.     .AutoFilter Field:=2, Criteria1:=Worksheets("sheet1").Cells(i, 8)
   
9.     .AutoFilter Field:=3, Criteria1:=Worksheets("sheet1").Cells(i, 3)
   
10.     .AutoFilter Field:=4, Criteria1:="買權"
    
11.     .Offset(1, 4).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Worksheets("選擇權資料").Cells(i, 1)
    
12.   Next
    
13.   .AutoFilter
    
14. End With
    
15. Application.ScreenUpdating = True
    
16. MsgBox Timer - t & "秒"
    
17. End Sub

複製代碼

ginbow

回復 6# register313


    謝謝大大~