帖子: 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

超級版主 Rank: 8 Rank: 8

帖子: 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
抓取符合條件的"第一筆", 不清楚你的邏輯 ,試試看

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

gn001038600

中學生 Rank: 2

帖子: 21
主題: 1
精華: 0
積分: 52
點名: 0
作業系統: WIN7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2015-3-13
最後登錄: 2024-5-2

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

中學生 Rank: 2

帖子: 21
主題: 1
精華: 0
積分: 52
點名: 0
作業系統: WIN7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2015-3-13
最後登錄: 2024-5-2

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

小學生 Rank: 1

帖子: 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

小學生 Rank: 1

帖子: 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

小學生 Rank: 1

帖子: 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

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

8^#

發表於 2015-5-12 22:53 | 只看該作者

回復 7# boblovejoyce

試試

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

複製代碼

TOP

lpk187

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

9^#

發表於 2015-5-12 23:03 | 只看該作者

回復 7# boblovejoyce

執行時間約2.2秒

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

複製代碼

TOP

lpk187

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

10^#

發表於 2015-5-13 00:04 | 只看該作者

回復 1# boblovejoyce

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

TOP