- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 142
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2026-7-16
                
|
10#
發表於 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
複製代碼 |
|