- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 98
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-4-27
              
|
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
|
|
發表於 2012-8-2 22:46
| 
