12
返回列表 上一主題 發帖

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

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

gn001038600

帖子
21 
主題
1 
精華
0 
積分
52 
點名
0  
作業系統
WIN7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-3-13 
最後登錄
2023-10-16 
3#
發表於 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

您可以試看看這樣

TOP

gn001038600

帖子
21 
主題
1 
精華
0 
積分
52 
點名
0  
作業系統
WIN7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-3-13 
最後登錄
2023-10-16 
4#
發表於 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

您可以試看看這樣

TOP

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
5#
發表於 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

TOP

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
6#
發表於 2015-5-12 19:50 | 只看該作者
回復 4# gn001038600

感謝gn001038600大大的回覆

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

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

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

我提供了我原始的範例

TOP

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
7#
發表於 2015-5-12 19:56 | 只看該作者
回復 5# boblovejoyce

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

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 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
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 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
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
10#
發表於 2015-5-13 00:04 | 只看該作者
回復 1# boblovejoyce

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

TOP

        靜思自在 : 能善用時間的人，必能掌握自己努力的方向。
12
返回列表 上一主題