[發問] 只想要抓取符合條件的"第一筆"其他不要

boblovejoyce

各位高手前輩~
拼拼湊湊弄了下面的程式碼,可以滿足到目前的需求~但是執行速度好慢~
目前可以修正我的程式碼~用更好的方式調整嗎?

我想要將  符合我給的條件 去 A row尋找
找到符合我要的值時,就往上搜索到符合條件的欄位,把這個欄位的值 抓走
可是我只要抓符合條件的第一筆資料,其他的不要~
就這樣,我用了錄製聚集的方式~~傻傻地完成了
可是這不是我想要的速度~好慢喔
有機會調整嗎?懇求指點一二

有想過丟到陣列去~但目前還不會如何去陣列搜索符合我要的第一筆資料~因為會有很多筆類似
懇求指點一二
聽同學說~~方法很多種~但我還沒有開竅 ORZ:'(

Sub TEST ()
Dim zz As String

For i = 2 To Cells(Rows.Count, 10).End(xlUp).Row
    zz = Cells(i, 10).Value
    Columns("A:A").Select

    Selection.Find(What:=zz, after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate

    Cells.Find(What:="  (net ", after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate

    Cells(i, 11) = ActiveCell
    Cells(i, 11) = Right(Cells(i, 11), Len(Cells(i, 11)) - 7)

  Next
  Cells(1, 10).Select


End Sub

GBKEE

回復 1# boblovejoyce
抓取符合條件的"第一筆", 不清楚你的邏輯 ,試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Ar() As Variant, Ay() As Variant, i As Single, Msg As Variant
   
4.     With Sheet1
   
5.         Ar = .Range(.Cells(2, 10), .Cells(Rows.Count, 10).End(xlUp))  '陣列元素由儲存格取得為二維陣列
   
6.         Ar = Application.WorksheetFunction.Transpose(Ar)           '轉置為一維陣列
   
7.         If Join(Ar, "") = "" Then  'Join 函數 傳回一個字串，該字串是透過連結某個陣列中的多個子字串而建立的。
   
8.             MsgBox "沒資料"
   
9.             Exit Sub
   
10.         End If
    
11.         ReDim Ay(1 To UBound(Ar))   '同Ar大小的陣列
    
12.         For i = 1 To UBound(Ar)
    
13.             With .[A:A]
    
14.                 'After:=.Cells(.Cells.Count) 從最後一個儲存格
    
15.                 If Not .Find(Ar(i), After:=.Cells(.Cells.Count), lookat:=xlPart) Is Nothing Then
    
16.                     Ay(i) = .Find(Ar(i), After:=.Cells(.Cells.Count), lookat:=xlPart)
    
17.                     Ay(i) = Right(Ay(i), Len(Ay(i)) - IIf(Len(Ay(i)) > 7, 7, 0))
    
18.                 End If
    
19.             End With
    
20.         Next
    
21.         .Cells(2, 11).Resize(UBound(Ar), 1).Value = Application.WorksheetFunction.Transpose(Ay)
    
22.         '陣列元素由左而右:由上而下須轉置
    
23.     End With
    
24. End Sub

複製代碼

gn001038600

sub aa()
dim data(100)

for i = 2 to sheet1.range("A65536").end(xlup).row
         if sheet1.cells(i,1)="你的條件"  then
                 a=a+1
                 data(a)=sheet1.cells(i,1)
         endif
next

for i = 1 to a
      <你要輸出的位置>=data(i)
next
end sub

您可以試看看這樣

gn001038600

回復 1# boblovejoyce
抱歉沒看到您只要第一筆
修正如下

sub aa()
dim data(100)

for i = 2 to sheet1.range("A65536").end(xlup).row
         if sheet1.cells(i,1)="你的條件"  then
                 a=a+1
                 data(a)=sheet1.cells(i,1)
                 goto lab1
         endif
next

lab1:
for i = 1 to a
      <你要輸出的位置>=data(i)
next
end sub

您可以試看看這樣

boblovejoyce

回復 2# GBKEE

謝謝超級板主的解答,正在往最後解答前進中
不好意似,因為我沒敘述清楚 我的第一筆條件是什麼?
我RUN了版主的程式碼,會抓取資料~但因為定義的第一筆條件沒有說清楚
所以抓的資料不是需要的~~我有拿錶去計算時間~跑完約要15秒鐘~
舉例:
我想要去Cells(2, 10)一直到相對應的最後一筆資料,當成我搜索的條件
假設    Cells(2, 10)=王小明

這個時候,我就會依據 "王小明" ,去A欄搜索到 "王小明"
可是 "王小明" 只是我在A欄的觸發條件
我會依照"王小明"這個A欄中的儲存格位置,再度繼續往上尋找 "  (net "
可是這個時候總共會遇到三次"  (net
"  (net 小叮噹
"  (net 阿福
"  (net 大雄

但我只想要第一次遇到的"  (net  ,在這個範例中就是大雄,大雄就是我想要丟到Cells(2, 11)的值
因為格式是固定的,"  (net    <--這是固定的
後面的人名都會隨機變動~

很改謝超級板主回覆我~~3Q

boblovejoyce

回復 4# gn001038600

感謝gn001038600大大的回覆

因為我的條件已經沒問題了
可是我要使用這個"條件" 繼續在 A欄位中 以"條件"這個儲存格所在位置 test0512.rar (653.7 KB)

0512
下載次數: 1

2015-5-12 19:49

繼續"往上搜索"...直到我搜索到第一筆 "條件2"的時候,把它抓走

條件2  (第3次遇到)
條件2  (第2次遇到)
條件2  (第1次遇到)

我只想要抓走 第1次遇到 的條件2 ,放到我想要放的地方

我提供了我原始的範例

boblovejoyce

回復 5# boblovejoyce

板主大大
超感謝你的回覆
我敘述的可能不夠清楚
我把我的範例先丟上來~若有空閒 可以幫我喵一下嗎?
test0512.rar (653.7 KB)

下載次數: 12

2015-5-12 19:55

lpk187

回復 7# boblovejoyce

試試

1. Sub test()
   
2. i = 0
   
3. Dim arr2()
   
4. Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
   
5. arr = Range("J2:J" & Cells(Rows.Count, 10).End(xlUp).Row)
   
6. For Each ar In arr
   
7. ReDim Preserve arr2(i)
   
8.     Set zz = Rng.Find(ar, , , , , 2)
   
9.     Set aa = Rng.Find("  (net ", Range(zz.Address), , , , 2)
   
10.     arr2(i) = aa
    
11.     arr2(i) = Right(arr2(i), Len(arr2(i)) - 7)
    
12.     i = i + 1
    
13. '    '移除前面8個字元
    
14.   Next
    
15.    Range("K2").Resize(UBound(arr2) + 1) = Application.WorksheetFunction.Transpose(arr2)
    
16. End Sub

複製代碼

lpk187

回復 7# boblovejoyce

執行時間約2.2秒

1. Sub test()
   
2. t = Timer
   
3. i = 0
   
4. Dim arr2()
   
5. Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
   
6. arr = Range("J2:J" & Cells(Rows.Count, 10).End(xlUp).Row)
   
7. For Each ar In arr
   
8. ReDim Preserve arr2(i)
   
9.     Set zz = Rng.Find(ar, , , , , 2)
   
10.     Set aa = Rng.Find("  (net ", Range(zz.Address), , , , 2)
    
11.     arr2(i) = aa
    
12.     arr2(i) = Right(arr2(i), Len(arr2(i)) - 7)
    
13.     i = i + 1
    
14. '    '移除前面8個字元
    
15.   Next
    
16.    Range("K2").Resize(UBound(arr2) + 1) = Application.Transpose(arr2)
    
17. MsgBox Format(Timer - t, "0.0000")
    
18. End Sub

複製代碼

lpk187

回復 1# boblovejoyce

反覆的執行你的原程式，執行的時間很長的原因是資料過多，近8萬行的資料
而第一個Find尋找又是向下尋找，結果找的資料都後面，光是第一個Find就用掉很多時間
我試了向上尋找，整體的時間差了近20秒，還有Select、 Selection、Activate也會因為螢幕的處理速度影響到整體尋找的速度