GBKEE

¦^´_ 5# cmo140497
ª½±µ½Æ»s

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim mytbl As Range, myQry As Range, P As Pictures, I As Integer
   
4.     Application.ScreenUpdating = False
   
5.     With Sheets("¤u§@ªí1")
   
6.         .Activate
   
7.         .[a1].CurrentRegion.ClearContents
   
8.         .Range("J1", .[J1].End(xlToRight)).EntireColumn.Clear  '²M°£Â¦³¸ê®Æ (Clear µLªk§R°£¹Ï¤ù)
   
9.         Set P = .Pictures                                      '¹Ï¤ù¶°¦X
   
10.         For I = P.Count To 1 Step -1
    
11.             If Intersect(.Range(P(I).TopLeftCell.Address), .[F:F]) Is Nothing Then '¹Ï¤ù¦ì¸m¤£¦b FÄæ
    
12.                 P(I).Delete                                    '¹Ï¤ù §R°£
    
13.             End If
    
14.         Next
    
15.         Set mytbl = .[F:I]
    
16.         Set myQry = .[a1]
    
17.         mytbl.Columns(4).AdvancedFilter xlFilterCopy, copytorange:=myQry, unique:=True
    
18.         Set myQry = myQry.CurrentRegion
    
19.         For I = 2 To myQry.Rows.Count
    
20.             With mytbl
    
21.                 .AutoFilter 4, myQry.Rows(I)
    
22.                 .SpecialCells(xlCellTypeVisible).Copy
    
23.                 .Parent.Cells(1, .Parent.Columns.Count).End(xlToLeft).Offset(, 1).Select
    
24.                 .Parent.Paste
    
25.                 'ActiveSheet.Paste
    
26.             End With
    
27.         Next
    
28.     End With
    
29.     mytbl.AutoFilter
    
30.     myQry.Select
    
31.     Application.ScreenUpdating = True
    
32. End Sub

½Æ»s¥N½X