Board logo

標題: [發問] 只想要抓取符合條件的"第一筆"其他不要 [打印本頁]
作者: boblovejoyce    時間: 2015-5-11 23:35     標題: 只想要抓取符合條件的"第一筆"其他不要

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

我想要將  符合我給的條件 去 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    時間: 2015-5-12 08:17

回復 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    時間: 2015-5-12 11:33

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    時間: 2015-5-12 11:40

回復 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    時間: 2015-5-12 19:39

回復 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    時間: 2015-5-12 19:50

回復 4# gn001038600

感謝gn001038600大大的回覆

因為我的條件已經沒問題了
可是我要使用這個"條件" 繼續在 A欄位中 以"條件"這個儲存格所在位置[attach]20932[/attach]
繼續"往上搜索"...直到我搜索到第一筆 "條件2"的時候,把它抓走

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

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

我提供了我原始的範例
[attach]20932[/attach]
作者: boblovejoyce    時間: 2015-5-12 19:56

回復 5# boblovejoyce

板主大大
超感謝你的回覆
我敘述的可能不夠清楚
我把我的範例先丟上來~若有空閒 可以幫我喵一下嗎?
[attach]20933[/attach]
作者: lpk187    時間: 2015-5-12 22:53

回復 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    時間: 2015-5-12 23:03

回復 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    時間: 2015-5-13 00:04

回復 1# boblovejoyce

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

本帖最後由 boblovejoyce 於 2015-5-13 08:53 編輯

回復 10# lpk187

剛剛測試了一下~感謝lpk187
你點中了我的要害....就如你所述的一模一樣~
執行變快了~~差了好多喔~~真的只要2秒以內

謝謝大大
可能我的電腦比較快一點 我看到的是1.8X秒~~神
作者: boblovejoyce    時間: 2015-5-29 17:25

回復 9# lpk187

親愛的 lpk187大大
    Set zz = Rng.Find(ar, , , , , 2)
    Set aa = Rng.Find("  (net ", Range(zz.Address), , , , 2)

我想問一下一個概念 為什麼需要這麼多 ,,,,, 逗號
要分隔什麼?什麼意思
請指引給小弟一個觀念?or 有相關訊息我去爬文查找?
感謝你
作者: GBKEE    時間: 2015-5-29 19:36

回復 12# boblovejoyce
沒有指明參數名稱，，，點出參數位置。
請看VBA中 Find 的說明
作者: lpk187    時間: 2015-5-29 21:00

回復 12# boblovejoyce

如版大的回答，需要那麼多逗點，是省略參數或默認預設值，最後的2則是XlSearchDirection的值如下說明，它可以用名稱或值表示之
名稱               值         描述
xlNext            1    搜尋範圍中的下一個符合值。
xlPrevious     2     搜尋範圍中的上一個符合值。
[attach]21063[/attach]
作者: boblovejoyce    時間: 2015-5-29 23:15

感謝兩位說明
我懂了

Ok,我再去讀說明一下
作者: Scott090    時間: 2015-5-30 10:07

回復 7# boblovejoyce

如果使用  陣列操作， 在我的電腦只要 0.324秒；只做參考：
  1. Option Base 1

  3. Sub test1()
  4. t = Timer
  5. Dim arr, arr1, arr2
  6. Dim i&, j&, k&
  7. arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
  8. arr = Range("J2:J" & Cells(Rows.Count, 10).End(xlUp).Row)
  9. ReDim arr2(UBound(arr), 1)
  10. For i = 1 To UBound(arr)
  11.     For j = UBound(arr1) To 1 Step -1
  12.         If InStr(arr1(j, 1), arr(i, 1)) <> 0 Then
  13.             For k = j To 1 Step -1
  14.                 If InStr(arr1(k, 1), "  (net ") <> 0 Then
  15.                     arr2(i, 1) = Right(arr1(k, 1), Len(arr1(k, 1)) - 7) '    '²¾°£«e±8Ó¦r¤¸
  16.                     GoTo Nexti
  17.                 End If
  18.             Next
  19.         End If
  20.     Next
  21. Nexti:
  22.   Next
  23.    Range("L2").Resize(UBound(arr2)) = arr2
  24. MsgBox Format(Timer - t, "0.0000")
  25. End Sub
複製代碼
作者: boblovejoyce    時間: 2015-5-31 22:10

回復 16# Scott090
@@ 明天去測試一下
現在只有手機可用
現謝過了,之後再來回報和問問題
作者: boblovejoyce    時間: 2015-6-1 09:04

回復 16# Scott090
剛剛測試完畢~大大的又更神速了~感謝大大指導
作者: boblovejoyce    時間: 2015-6-4 23:12

回復 16# Scott090
Option Base 1
宣告起始陣列從1開始
它的好處或是使用上 有什麼特別之處?
作者: Scott090    時間: 2015-6-5 07:46

回復 19# boblovejoyce


    只是個人邏輯思考喜好，以及要設定 下限為1的陣列不必每個 分別定義 "1 to ...."
在使用上要注意的是 Excel 某些產生陣列的函數不受影響，碰到過，但忘記了

2010 VBA 說明 "Array 函數所建立的陣列預設下限必為零，不受 Option Base 所影響" ，好像是錯誤的。



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)