Hsieh版主 Re: sheet2內容固定,比對sheet1後,將符合的列複製於sheet3
« 回覆文章 #9 於: 2010-02-28, 18:07:56 »
程式碼:
Sub nn()
Dim Rng As Range, A As Range, Cell As Range
With Sheet2
Set Rng = .Range(.[A1], .[A65536].End(xlUp))'設置比對的標準區域
End With
With Sheet1
For Each A In .Range(.[D1], .[D65536].End(xlUp))'在sheet1的d欄資料循環
If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then'如果標準區找到d欄的值
If Cell Is Nothing Then Set Cell = A Else Set Cell = Union(Cell, A)'如果變數Cell是不是物件就將d欄設給Cell否則Cell就會將原來範圍增加一儲存格A
End If
Next
End With
Sheet3.Cells = ""'清空Sheet3內容
Cell.EntireRow.Copy Sheet3.[A1]'把Sheet1符合的列複製到Sheet3的A1
Sub AA_Table()
Dim A As Range, C As Range, Ar() //定義變數
With Sheets("B全部紀錄") //用B表
For Each A In .Range(.[A2], .[A1048576].End(xlUp)) //A欄 逐列處理
Set C = Sheets("A收集").Columns("C").Find(A, lookat:=xlWhole) //在A收集的c欄 尋找A . 是不是這邊應該要反過來寫 在B全部紀錄A欄 尋找A?
If Not C Is Nothing Then
ReDim Preserve Ar(s)
Ar(s) = Array(C.Offset(, -2).Value, C.Offset(, -1).Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value) //設定 C輸出五欄的值
s = s + 1
End If
Next
End With
Sheets("C輸出").[A2:E1048576].Clear
If s > 0 Then Sheets("C輸出").[A2].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
Sheets("C輸出").Select
End Sub作者: Hsieh 時間: 2010-6-10 23:02
)