12
返回列表 上一主題 發帖

[發問] 如何從兩欄中尋找出指定值

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-4-27 18:19 | 只看該作者

[發問] 如何從兩欄中尋找出指定值

各位先進

sheet1表約有4000筆資料列(含空白列)
VBA是否可以篩選出兩欄中完全相同的值如附檔說明?

煩請大大 前輩指導
TEST27.rar (64.3 KB)
收藏 分享

lilytracy

帖子
12 
主題
5 
精華
0 
積分
56 
點名
0  
作業系統
Window7 
軟體版本
office2010 
閱讀權限
20 
註冊時間
2011-8-3 
最後登錄
2015-5-10 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
2#
發表於 2013-4-28 14:54 | 只看該作者
回復 1# luke

若查首筆資料如下
  1. Sub Test()
  2. Dim Txt1 As String, Txt2 As String
  3. Txt1 = [D3]
  4. Txt2 = [E3]
  5.   [D3] = IIf(Left(Txt1, 1) = ";", Mid(Txt1, 2, Len(Txt1) - 1), Txt1)
  6.   [E3] = IIf(Left(Txt2, 1) = ";", Mid(Txt2, 2, Len(Txt2) - 1), Txt2)
  7.     Cells.Find(What:=[D3], LookIn:=xlValues).Activate
  8.      i = 1
  9.       Do
  10.        Cells.FindNext(After:=ActiveCell).Activate
  11.         If Cells(ActiveCell.Row, 1).Value = [D3] And Cells(ActiveCell.Row, 2).Value = [E3] Then
  12.          Exit Do
  13.           ElseIf i > 4000 Then
  14.           MsgBox "查無 " + [D3] + [E3] & "資料"
  15.          Exit Do
  16.         End If
  17.       i = i + 1
  18.     Loop
  19. End Sub
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2013-4-28 15:46 | 只看該作者
回復 1# luke
  1. Option Explicit
  2. Sub Ex()
  3.     Dim R As Range, W As String, Rng As Range
  4.     With ActiveSheet
  5.         W = Application.Phonetic(.[D3:E3])       '結合兩字串
  6.         For Each R In .Range("A:B").SpecialCells(xlCellTypeConstants).Rows '有資料的儲存格
  7.             If W = Application.Phonetic(R) Then
  8.                 If Rng Is Nothing Then
  9.                     Set Rng = R
  10.                 Else
  11.                     Set Rng = Union(Rng, R)
  12.                 End If
  13.             End If
  14.         Next
  15.         If Rng Is Nothing Then
  16.             MsgBox "查無 " & .[D3] & .[E3] & "資料"
  17.         Else
  18.             Rng.Select
  19.             MsgBox "共 " & Rng.Cells.Count / 2 & "筆 資料"
  20.         End If
  21.     End With
  22. End SubEnd Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
4#
發表於 2013-5-1 18:28 | 只看該作者
回復 3# GBKEE

謝謝超版答覆

    若sheet1表的A:B欄資料區是由兩個(或多個)文字檔匯入,  並有「END」檔尾區隔
    如果想跳過第1個有「END」 結尾, 來進行sheet1表D3和E3的查詢, 即D3輸入「DD」
    和E3輸入「Z1」  會先跳過第1個有「END」, 然後由下找到位於第2個資料區的
    【儲存格A45】而不是【儲存格A19】.
     
     同理: sheet1表D3輸入「BB」和E3輸入「X001」是否能往下跳  
    至第2個資料區的【儲存格A56】而不是【儲存格A32】

    以上是否可行?
    應如何修改VBA?
TEST27A.rar (30.21 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2013-5-2 07:41 | 只看該作者
回復 5# luke
  1. Private Sub Auto_open()   'Module1 於檔案開啟時自動執行的程式,要定義:"END"區塊位置
  2.     'Names.Add 活頁簿中定義新名稱
  3.         With sheet1.Range("A:A")
  4.         If Not .Find("END", lookat:=xlWhole) Is Nothing Then
  5.             .Replace "END", "=EX", xlWhole
  6.             '將"END"替代為公式,因為無效的公式,儲存格傳回錯誤值
  7.             With .SpecialCells(xlCellTypeFormulas, xlErrors)
  8.                 Names.Add "資料區", RefersTo:=.Parent.Range(.Address)
  9.                 .Value = "END"    '儲存格傳回錯誤值:回復原字串
  10.             End With
  11.             Names.Add "按鈕次數", 1           '按鈕1 第一個資料區
  12.         Else
  13.             Names.Add "按鈕次數", 0           '按鈕1
  14.         End If
  15.     End With
  16. End Sub
  17. Sub Ex()
  18.     Dim i As Integer, W As String, Rng As Range
  19.     If [按鈕次數] = 0 Then
  20.         MsgBox "資料區 沒有 END區塊 "
  21.         Exit Sub
  22.     End If
  23.     With ActiveSheet
  24.         W = Application.Phonetic(.[D3:E3])       '結合兩字串
  25.         'i = [資料區].Areas([按鈕次數]).Row       '第 i 個"END"資料區的列號
  26.         For i = [資料區].Areas([按鈕次數]).Row To [資料區].Areas([資料區].Areas.Count).Row
  27.             If W = Application.Phonetic(.Range("A:B").Rows(i)) Then
  28.                 Names.Add "按鈕次數", [按鈕次數] + 1   '
  29.                 Set Rng = .Range("A:B").Rows(i)
  30.                 Exit For   '找到第一個 離開迴圈
  31.             End If
  32.         Next
  33.         If Rng Is Nothing Then
  34.             MsgBox "查無 " & .[D3] & .[E3] & "資料"
  35.         Else
  36.             Rng.Select
  37.             MsgBox "找到 " & Rng.Cells(1, 1).Address(0, 0)
  38.         End If
  39.     End With
  40.      If [資料區].Areas.Count = [按鈕次數] Then Names.Add "按鈕次數", 1     '[按鈕次數] 回到第一次
  41. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
6#
發表於 2013-5-2 10:52 | 只看該作者
回復 7# GBKEE


    謝謝超版答覆

若sheet1表D3儲存格內容固定不變(不考慮E3儲存格), 如果想跳過第1個有「END」資料區,
然後由第2個資料區去查詢A:B欄中, 去做進階篩選(如圖片所示)出符合D3儲存格的全部資料.

例如:D3輸入「EEE」,從第2個資料區A欄
可找出第45列、第48列和第51列共有3列有「EEE」相同值如下:

第45列 EEE→Y01
第48列 EEE→Y04
第51列 EEE→Y02

如何修改VBA將A:B欄中的這些符合篩選資料複製至G:H欄?
TEST27B.rar (28.83 KB)
TEST27B.gif

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2013-5-2 15:34 | 只看該作者
回復 6# luke
果想跳過第1個有「END」資料區
只有1個「END」資料區嗎??????
請將問題完整的提出來!!!
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
8#
發表於 2013-5-3 23:12 | 只看該作者
回復 7# GBKEE


回復超版

以下是說明, 請參考附件{WORK結果}表所示結果

說明: 從[Sheet1表]A:C欄匯入文字檔可分為A型和B型.
[A型]
1.當匯入A型文字檔會有「END」(稱第1個資料區)及/或數量不等的資料區(稱第2個資料區、第3個資料區、第4資料區…餘此類推)如從Sheet1表A:C欄所示, 其中第1個資料區帶有空白資料列, 而第2個資料區以後, 每個資料區有數量不等資料列(但不含空白資料列). [Sheet1表]G:I欄是由D3儲存格(E3用Y*)為做查詢並先跳過「END」再行找出篩選結果. 例如:D3輸入「EEE」時會找出符合的Y01, Y04和Y02共3筆資料, 然後顯示結果(如G1:I3)於Sheet1表G:I欄(I欄有超連結功能).

2.[WORK表]是資料寫入工作表,其最後1列有1個「END」檔尾(上1列為空白資料列), [Sheet1表]的第1個資料區是以此「END」做複製目的. 當選取[Sheet1表]的第1個資料區後再複製至[WORK表]並覆蓋「END」貼上. 若A型文字檔還有其他的資料區就要做相互尋找與插入(複製貼上)功能; 並利用上述篩選結果, 由[WORK表] G:H欄開始先找出G1和H1內容如G1=「EEE」和H1=「Y01」(本例如第1點說明)進行[Sheet1表]的第2個資料區(如A13:C14)做複製, 然後切換至[WORK表]去找到符合[Sheet1表] G1=「EEE」和H1=「Y01」的位址, 將[Sheet1表]的第2個資料區插入此位址(如[WORK表]所示結果).

同理:
繼續做下個G2=「EEE」和H2=「Y04」並將[Sheet1表] 的第3個資料區(如A16:C17)做複製並插入至[WORK表]符合[Sheet1表] G2=「EEE」和H2=「Y04」的位址. 然後繼續做下個G3=「EEE」和H3=「Y02」並將[Sheet1表] 的第4個資料區(如A19:C21)做複製並插入至[WORK表]符合[Sheet1表] G3=「EEE」和H3=「Y02」的位址…餘此類推

[B型]
當匯入B型文字檔至[Sheet1表]A:C欄(範例顯示於L: M欄)就會有「MMM」做檔尾, 但不會有「END」,其資料是以[Sheet1表]D3和E3來做[WORK表]刪除功能. 若D3輸入「EEE」和E3輸入「Y15」,就會進行[WORK表]符合D3:「EEE」和E3:「Y15」查詢, 找到此筆資料(僅1筆)的地址後,往上選取[WORK表]A:C欄區塊資料列並做該區塊資料列刪除工作, 然後將B型文字檔的[Sheet1表]資料全部選取(如L3:N8)並插入貼至[WORK表]該處(如C34)即完成.

應如何修改VBA達到這樣的結果?
TEST27B.rar (104.77 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2013-5-5 21:11 | 只看該作者
本帖最後由 GBKEE 於 2013-5-5 21:12 編輯

回復 8# luke
不好意思,看了兩天,你說的很詳細但還是看不懂
可以附上檔案的4個工作表內容是
1 [SHEET1 A]工作表是  文字檔A型
2 [SHEET1 B]工作表是  文字檔B型
3 [A WORK]工作表是 :  文字檔A型 貼上[A WORK]工作表 後 執行 複製 插入 的範例
4 [B WORK]工作表是 :   文字檔B型 貼上[A WORK]工作表 後 執行 刪除 插入 的範例
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
10#
發表於 2013-5-29 06:01 | 只看該作者
本帖最後由 luke 於 2013-5-29 06:05 編輯

回復 9# GBKEE


    回覆超版

    1.[Sheet1表]插入資料至[WORK表]有4個資料區
        A1:C10
        A13:C16
        A18:C21
        A23:C27
2.執行「寫入WORK」按鍵時因[WORK表]有部份資料列與[Sheet1表]重覆就會產生錯誤, 若[WORK表]改copy方式, 直接複製[Sheet1表]的4個資料區至[WORK表]

If D.EXISTS(A.Cells(1, 1) & A.Cells(1, 2)) Then
D(A.Cells(1, 1) & A.Cells(1, 2)).Copy
With A.Resize(1, D(A.Cells(1, 1) & A.Cells(1, 2)).Columns.Count)
.Insert Shift:=xlDown
End With
End If

應如何修改 上述VBA語法?

以上
TEST27D.rar (37.33 KB)

TOP

        靜思自在 : 修行要繫緣修心，藉事練心，隨處養心。
12
返回列表 上一主題