123
返回列表 上一主題 發帖

[發問] 在同一列同時比對兩欄資料方法

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2012-8-2 17:00 | 只看該作者
回復 9# 假面超人
依據你的檔案 寫下進階篩選的程式
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 2) As Range
  4.     Set Rng(1) = Sheet1.Range("a1").CurrentRegion   '進階篩選: 準則範圍  取得為 Sheet1[A1:A3]
  5.     Set Rng(2) = Sheets("最終結果").Range("A1").CurrentRegion
  6.     Rng(2) = ""                                     '清理先前篩選的資料
  7.     Rng(1).Rows(1).Copy Rng(2).Cells(1)             '複製 準則的欄位
  8.     '試試看將上一行程式碼註解不執行看看
  9.     '進階篩選 : 複製到目的範圍 第1列有那些資料庫的欄位 就顯示那些資料
  10.     '如空白 會顯示全部欄位的資料
  11.     Sheet2.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Rng(1), Rng(2).CurrentRegion
  12. End Sub
複製代碼

TOP

smouse0220

帖子
9 
主題
0 
精華
0 
積分
14 
點名
0  
作業系統
windows7 
軟體版本
9 
閱讀權限
10 
性別
男 
註冊時間
2012-7-31 
最後登錄
2012-12-3 
12#
發表於 2012-8-2 19:32 | 只看該作者
回復  smouse0220


真的太謝謝你了，這樣讓又能繼續寫下去了!

第15列中的                         ...
假面超人 發表於 2012-8-2 13:31


0802.rar (9.52 KB)

TOP

假面超人

帖子
18 
主題
3 
精華
0 
積分
26 
點名
0  
作業系統
WIN7 
軟體版本
office2007 
閱讀權限
10 
性別
男 
註冊時間
2012-8-1 
最後登錄
2012-9-1 
13#
發表於 2012-8-2 19:35 | 只看該作者
回復 11# GBKEE

追加問一個問題
如果要搜尋123,124兩筆資料
123的資料在工作頁2裡可找到
124的資料在工作頁3裡可找到

我用您的程式碼修改
  1. For a = 2 To 3
  2.             Sheets(a).Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Rng(1), Rng(2).CurrentRegion
  3.         Next
複製代碼
加了這迴圈，這樣他兩筆資料都會找到，可是當第2次找到時就會把第1次找到的資料蓋掉，是否可以讓第二2找到的資料在第1次的資料之下以此類推

TOP

假面超人

帖子
18 
主題
3 
精華
0 
積分
26 
點名
0  
作業系統
WIN7 
軟體版本
office2007 
閱讀權限
10 
性別
男 
註冊時間
2012-8-1 
最後登錄
2012-9-1 
14#
發表於 2012-8-2 19:40 | 只看該作者
回復 12# smouse0220

sorry...
我的等級不足，無法下載檔案，是否方便上傳到免空
http://imxd.net/

TOP

smouse0220

帖子
9 
主題
0 
精華
0 
積分
14 
點名
0  
作業系統
windows7 
軟體版本
9 
閱讀權限
10 
性別
男 
註冊時間
2012-7-31 
最後登錄
2012-12-3 
15#
發表於 2012-8-2 20:38 | 只看該作者
回復 14# 假面超人

Fyi.
http://imxd.net/file?id=6716

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 2012-8-2 20:46 | 只看該作者
回復 13# 假面超人
  1. Option Explicit
  2. Sub Ex() '有多於2個以上的工作表要篩選
  3.     Dim Rng(1 To 3) As Range, a As Integer, Sh_Count As Integer
  4.     Sh_Count = Sheets.Count   '此活頁簿中工作表的總數
  5.     Set Rng(1) = Sheets(1).Range("a1").CurrentRegion   '進階篩選: 準則範圍  取得為 Sheet1[A1:A3]
  6.     'Set Rng(2) = Sheets("最終結果").Range("A1").CurrentRegion  '改為此活頁簿中最後的工作表
  7.     Set Rng(2) = Sheets(Sh_Count).Range("A1").CurrentRegion
  8.     Rng(2) = ""                                     '清理先前篩選的資料
  9.     Rng(1).Rows(1).Copy Rng(2).Cells(1)             '複製 準則的欄位
  10.     For a = 2 To Sheets.Count - 1
  11.         Sheets(a).Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Rng(1), Rng(2).Cells(1).Resize(1, Rng(1).Columns.Count)
  12.         Set Rng(2) = Rng(2).Cells(1).End(xlDown).Offset(1) '複製到目的範圍 往下移動
  13.         If a <> Sheets.Count - 1 Then Rng(1).Rows(1).Copy Rng(2).Cells(1)
  14.         If Rng(3) Is Nothing Then             '紀錄複製第2個工作表以後的複製到目的範圍欄位 第一列位置
  15.             Set Rng(3) = Rng(2).Cells(1).Resize(1, Rng(1).Columns.Count)
  16.         Else
  17.             Set Rng(3) = Union(Rng(3), Rng(2).Cells(1).Resize(1, Rng(1).Columns.Count))
  18.         End If
  19.     Next
  20.     If Not Rng(3) Is Nothing Then Rng(3).Delete xlUp  '刪除 紀錄複製第2個工作表以後的複製到目的範圍欄位 第一列位置
  21. End Sub
複製代碼

TOP

假面超人

帖子
18 
主題
3 
精華
0 
積分
26 
點名
0  
作業系統
WIN7 
軟體版本
office2007 
閱讀權限
10 
性別
男 
註冊時間
2012-8-1 
最後登錄
2012-9-1 
17#
發表於 2012-8-2 21:26 | 只看該作者
回復 16# GBKEE


GBKEE版大一直麻煩你真的不好意思
針對您寫的那程式做了測試大致上沒問題
但有點小問題
搜尋到最後的排序會依照先在哪個分頁找到的寫入到最後會亂掉，是否可以能讓資料順序和工作頁1一樣?謝謝
多筆資料判斷(G大).rar (16.05 KB)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
18#
發表於 2012-8-2 21:29 | 只看該作者
回復 16# GBKEE
請教：
        Sheets(a).Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Rng(1), Rng(2).Cells(1).Resize(1, Rng(1).Columns.Count)
是不是要修改成：
        Sheets(2).Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Rng(1), Rng(2).Cells(1).Resize(1, Rng(1).Columns.Count)
否則下一個工作表單如為空白，則會有錯誤訊息。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
19#
發表於 2012-8-2 22:29 | 只看該作者
回復 16# GBKEE
看了#17樓的範例，霍然大悟。因為範例中沒有空白表單之故。

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
20#
發表於 2012-8-2 22:38 | 只看該作者
本帖最後由 Hsieh 於 2012-8-6 18:48 編輯

回復 17# 假面超人
是要照Sheet1的排序嗎?
  1. Sub nn()
  2. Dim Ar(), A As Range, B As Range
  3. With Sheets("Sheet1")
  4. For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))  第一頁A2以下做迴圈
  5.   For Each Sh In Sheets(Array("Sheet2", "Sheet3")) '原資料所在工作表
  6.   With Sh
  7.      For Each B In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))  '在A2以下儲存格做迴圈
  8.         If B = A Then  '跟第一頁A欄儲存格做比對，如果符合
  9.            ReDim Preserve Ar(s)  '擴大陣列
  10.            Ar(s) = Array(B.Value, B.Offset(, 1).Value, B.Offset(, 2).Value, B.Offset(, 4).Value)  '將值寫入陣列
  11.            s = s + 1  '準備下一次擴大陣列
  12.         End If
  13.      Next
  14.   End With
  15.   Next
  16.   With Sheets("最終結果")
  17.      If s > 0 Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(s, 4).Value = Application.Transpose(Application.Transpose(Ar))  '如果陣列有寫入，就將陣列寫入結果
  18.      Erase Ar: s = 0  '清空陣列，並準備下一個陣列初始大小
  19.   End With
  20. Next
  21. End With
  22. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
123
返回列表 上一主題