返回列表 上一主題 發帖

請問VBA尋找使用方法

ginbow

帖子
28 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
windows xp pro 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2010-5-5 
最後登錄
2016-6-8 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-5-26 00:00 | 只看該作者

請問VBA尋找使用方法

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

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

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

sheet1.rar (7.2 KB)

資料表

收藏 分享
GinBow

ginbow

帖子
28 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
windows xp pro 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2010-5-5 
最後登錄
2016-6-8 
7#
發表於 2012-6-7 00:16 | 只看該作者
回復 6# register313


    謝謝大大~
GinBow

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
6#
發表於 2012-5-27 17:59 | 只看該作者
回復 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
複製代碼

TOP

ginbow

帖子
28 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
windows xp pro 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2010-5-5 
最後登錄
2016-6-8 
5#
發表於 2012-5-26 23:49 | 只看該作者
回復 4# register313


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

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
4#
發表於 2012-5-26 16:34 | 只看該作者
回復 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
複製代碼

TOP

ginbow

帖子
28 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
windows xp pro 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2010-5-5 
最後登錄
2016-6-8 
3#
發表於 2012-5-26 15:46 | 只看該作者
謝謝 我稍微改了一下 可是不知道為什麼抓不到

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

sheet.rar (238.21 KB)

資料

GinBow

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
2#
發表於 2012-5-26 10:59 | 只看該作者
本帖最後由 register313 於 2012-5-26 14:05 編輯

回復 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
複製代碼

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題