Hsieh

¦^´_ 1# milkpillow

1. Sub Q_Table()
   
2. Dim A As Range, C As Range, Ar()
   
3. With Sheets("B¥þ³¡¬ö¿ý")
   
4. For Each A In .Range(.[A2], .[A1048576].End(xlUp))
   
5.    Set C = Sheets("A¦¬¶°").Columns("C").Find(A, lookat:=xlWhole)
   
6.      If Not C Is Nothing Then
   
7.        ReDim Preserve Ar(s)
   
8.        Ar(s) = Array(C.Offset(, -2).Value, C.Offset(, -1).Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
   
9.        s = s + 1
   
10.    End If
    
11. Next
    
12. End With
    
13. Sheets("C¿é¥X").[A2:E1048576].Clear
    
14. If s > 0 Then Sheets("C¿é¥X").[A2].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
    
15. Sheets("C¿é¥X").Select
    
16. End Sub

½Æ»s¥N½X

pro.rar (19.82 KB)

¤U¸ü¦¸¼Æ: 40

2010-5-29 09:01

PD961A

¦^´_ 1# milkpillow

     http://gb.twbts.com/index.php?topic=12801.0
    ¥DÃD: sheet2¤º®e©T©w,¤ñ¹ïsheet1«á,±N²Å¦Xªº¦C½Æ»s©ósheet3  

  Hsiehª©¥D   Re: sheet2¤º®e©T©w,¤ñ¹ïsheet1«á,±N²Å¦Xªº¦C½Æ»s©ósheet3
« ¦^ÂФ峹 #9 ©ó: 2010-02-28, 18:07:56 »  
µ{¦¡½X:
Sub nn()
Dim Rng As Range, A As Range, Cell As Range
With Sheet2
Set Rng = .Range(.[A1], .[A65536].End(xlUp))'³]¸m¤ñ¹ïªº¼Ð·Ç°Ï°ì
End With
With Sheet1
For Each A In .Range(.[D1], .[D65536].End(xlUp))'¦bsheet1ªºdÄæ¸ê®Æ´`Àô
¡@¡@If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then'¦pªG¼Ð·Ç°Ï§ä¨ìdÄ檺­È
¡@¡@¡@ If Cell Is Nothing Then Set Cell = A Else Set Cell = Union(Cell, A)'¦pªGÅܼÆCell¬O¤£¬Oª«¥ó´N±NdÄæ³]µ¹Cell§_«hCell´N·|±N­ì¨Ó½d³ò¼W¥[¤@Àx¦s®æA
¡@¡@End If
Next
End With
Sheet3.Cells = ""'²MªÅSheet3¤º®e
Cell.EntireRow.Copy Sheet3.[A1]'§âSheet1²Å¦Xªº¦C½Æ»s¨ìSheet3ªºA1
¡@¡@¡@
End Sub