123
返回列表 上一主題 發帖

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

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

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

假面超人

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

假面超人

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

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

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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2012-8-2 16:21 | 只看該作者
回復 9# 假面超人

進階篩選很容易達成
play.gif
如果堅持寫迴圈
  1. Sub ex()
  2. Dim Ar()
  3. With Sheet1
  4. For Each a In .Range(.[A2], .[A2].End(xlDown))
  5.    With Sheet2
  6.       For Each b In .Range(.[A2], .[A2].End(xlDown))
  7.          If b = a Then
  8.          ReDim Preserve Ar(s)
  9.          Ar(s) = Array(b.Value, b.Offset(, 1).Value, b.Offset(, 2).Value, b.Offset(, 4).Value)
  10.          s = s + 1
  11.          End If
  12.       Next
  13.    End With
  14.    Sheet3.[A65536].End(xlUp).Offset(1).Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
  15.    Erase Ar
  16.    s = 0
  17. Next
  18. End With
  19. End Sub
複製代碼
學海無涯_不恥下問

TOP

假面超人

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


多筆資料判斷.rar (9.03 KB)

這只是類似要處理的檔案
檔案來源是
第一個工作頁的品號欄由BOM表展開，後面的名稱、製程等都是後來要從其他工作頁抓過來填入
後面工作頁是由現場單位實際情況生產情況回報回來

目前要處理的動作
第一個工作頁的品號欄都是獨立不會重複，但其他工作頁的品號會重複(因為資料來源就是這樣)，所以我才會想既然裡面有工序，就以工序做第二判斷條件去抓取同一列裡面如工時等其他資料回寫到工作頁1裡面，如果有三個相同品號但工序不同的資料，會依照工序順序在下面又新增兩列，再把資料抓進來(這部分目前寫道變成無窮迴圈，還在動腦中)

TOP

假面超人

帖子
18 
主題
3 
精華
0 
積分
26 
點名
0  
作業系統
WIN7 
軟體版本
office2007 
閱讀權限
10 
性別
男 
註冊時間
2012-8-1 
最後登錄
2012-9-1 
8#
發表於 2012-8-2 14:39 | 只看該作者
剛試了一下，還是不行
我想要做的是
當判斷品號和工序是在同一列時
去抓在同一列裡面工時這個資料

原本只用vlooKup 去判斷和抓資料，但他只能判斷單一的資料
當遇到多筆重複的資料時只會去抓最先找的那一筆
摸索了好久
才想到VBA或許能解決這問題
請個位先進指點一下!!謝謝

TOP

假面超人

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


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

第15列中的                                   If Key_Word1="123" and Key_Word1="1" Then
好像有點問題，我修改成          If Key_Word1="123" and Key_Word2="2" Then
就能正常判斷了

TOP

        靜思自在 : 是非當教育，讚美作警惕。
123
返回列表 上一主題