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

帖子: 18
主題: 3
精華: 0
積分: 26
點名: 0
作業系統: WIN7
軟體版本: office2007
閱讀權限: 10
性別: 男
註冊時間: 2012-8-1
最後登錄: 2012-9-1

25^#

發表於 2012-8-6 23:09 | 只看該作者

回復 24# Hsieh
原來還有這樣用法，我沒看過...
謝謝您~~
還在努力學習中!!

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 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兔年全勤獎章

24^#

發表於 2012-8-6 22:34 | 只看該作者

本帖最後由 Hsieh 於 2012-8-6 22:38 編輯

回復 23# 假面超人

Sub nn()
Dim Ar(), A As Range, B As Range
With Sheets("Sheet1")
For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp)) '第一頁A2以下做迴圈
For Each Sh In Sheets(Array("Sheet2", "Sheet3")) '原資料所在工作表
With Sh
For Each B In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp)) '在A2以下儲存格做迴圈
If B = A Then '跟第一頁A欄儲存格做比對，如果符合
ReDim Preserve Ar(s) '擴大陣列
Ar(s) = Array(B.Value, B.Offset(, 1).Value, B.Offset(, 2).Value, B.Offset(, 4).Value) '將值寫入陣列
s = s + 1 '準備下一次擴大陣列
End If
Next
End With
Next
With Sheets("最終結果")
If s > 0 Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(s, 4).Value = Application.Transpose(Application.Transpose(Ar)) Else _
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4).Value =Array(A.value,"","","") '如果陣列有內容，就將陣列寫入結果，否則寫入一列空白
Erase Ar: s = 0 '清空陣列，並準備下一個陣列初始大小
End With
Next
End With
End Sub

複製代碼

17列的If陳述式，因為If...Then...在同一行所以不須End If詳細語法請參考VBA說明

學海無涯_不恥下問

帖子: 18
主題: 3
精華: 0
積分: 26
點名: 0
作業系統: WIN7
軟體版本: office2007
閱讀權限: 10
性別: 男
註冊時間: 2012-8-1
最後登錄: 2012-9-1

23^#

發表於 2012-8-6 17:37 | 只看該作者

回復 20# Hsieh

順便想請教，在第17列的位置用了IF但是為什麼下面不用END IF做結束
而18列的程式碼又是代表什麼意思呢?

帖子: 18
主題: 3
精華: 0
積分: 26
點名: 0
作業系統: WIN7
軟體版本: office2007
閱讀權限: 10
性別: 男
註冊時間: 2012-8-1
最後登錄: 2012-9-1

22^#

發表於 2012-8-6 16:51 | 只看該作者

回復 20# Hsieh

版大想請教一下，目前找不到資料是忽略掉(在最後一頁上找不到任何的資料)，是否可以改成找不到資料是否還是可以顯示第一頁的品號，其它欄位顯示"空白"或是"查無資料"?

帖子: 18
主題: 3
精華: 0
積分: 26
點名: 0
作業系統: WIN7
軟體版本: office2007
閱讀權限: 10
性別: 男
註冊時間: 2012-8-1
最後登錄: 2012-9-1

21^#

發表於 2012-8-2 22:46 | 只看該作者

回復 20# Hsieh

太謝謝Hsieh版大!!這是我想要的結果~
也謝謝smouse0220和GBKEE兩位..
在颱風假中還要動腦~
腦細胞應該死了不少...
萬分感謝

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 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兔年全勤獎章

20^#

發表於 2012-8-2 22:38 | 只看該作者

本帖最後由 Hsieh 於 2012-8-6 18:48 編輯

回復 17# 假面超人
是要照Sheet1的排序嗎?

Sub nn()
Dim Ar(), A As Range, B As Range
With Sheets("Sheet1")
For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp)) 第一頁A2以下做迴圈
For Each Sh In Sheets(Array("Sheet2", "Sheet3")) '原資料所在工作表
With Sh
For Each B In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp)) '在A2以下儲存格做迴圈
If B = A Then '跟第一頁A欄儲存格做比對，如果符合
ReDim Preserve Ar(s) '擴大陣列
Ar(s) = Array(B.Value, B.Offset(, 1).Value, B.Offset(, 2).Value, B.Offset(, 4).Value) '將值寫入陣列
s = s + 1 '準備下一次擴大陣列
End If
Next
End With
Next
With Sheets("最終結果")
If s > 0 Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(s, 4).Value = Application.Transpose(Application.Transpose(Ar)) '如果陣列有寫入，就將陣列寫入結果
Erase Ar: s = 0 '清空陣列，並準備下一個陣列初始大小
End With
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

19^#

發表於 2012-8-2 22:29 | 只看該作者

回復 16# GBKEE
看了#17樓的範例，霍然大悟。因為範例中沒有空白表單之故。

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 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)
否則下一個工作表單如為空白，則會有錯誤訊息。

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