在同一列同時比對兩欄資料方法 - Excel程式區

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

1^# 跳轉到 »

發表於 2012-8-1 23:32 | 顯示全部帖子

回復 1# 假面超人
進階篩選即可

學海無涯_不恥下問

TOP

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

2^#

發表於 2012-8-2 16:21 | 顯示全部帖子

回復 9# 假面超人

進階篩選很容易達成

如果堅持寫迴圈

Sub ex()
Dim Ar()
With Sheet1
For Each a In .Range(.[A2], .[A2].End(xlDown))
With Sheet2
For Each b In .Range(.[A2], .[A2].End(xlDown))
If b = a Then
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
Sheet3.[A65536].End(xlUp).Offset(1).Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
Erase Ar
s = 0
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

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

3^#

發表於 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

複製代碼

學海無涯_不恥下問

TOP

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

4^#

發表於 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說明

學海無涯_不恥下問

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]