½Ð±Ðª©¥D¤Î¦U¦ì¤j¤jÌ,¦p¦ó¨Ï¥Îautofilter ³s¦P·Ó¤ù¤]copy¦Ü¥Øªº¦a
- ©«¤l
- 95
- ¥DÃD
- 29
- ºëµØ
- 0
- ¿n¤À
- 150
- ÂI¦W
- 0
- §@·~¨t²Î
- windows2003
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- Kaoshiung
- µù¥U®É¶¡
- 2010-11-5
- ³Ì«áµn¿ý
- 2018-2-8
|
½Ð±Ðª©¥D¤Î¦U¦ì¤j¤jÌ,¦p¦ó¨Ï¥Îautofilter ³s¦P·Ó¤ù¤]copy¦Ü¥Øªº¦a
Dear ¦U¦ìª©¥D¤Î¤j¤j̱z¦n :
¤p§Ì¦³¤@°ÝÃD,¦p¦ó¨Ï¥Îautofilter or advancedfilter ¦b©ó¯S©w±ø¥ó¿z¿ï«á§@½Æ¨îªº°Ê§@,³s¦PÄæ¦ì¤j¤p¤ÎÀx¦s®æ¤º¤§·Ó¤ù
¤w³]©w¹Ï¤ùÄݩʬ°¤j¤p¦ì¸mÀHÀx¦s®æ§ïÅÜ,¤]¦³¨Ï¥ÎpastesAll,¤]§¡¤£±o¨ä¸Ñ,¦A³Â·Ð¦U¦ì¥i¥H¸Ñ¨M¤p§ÌªººÃ´b,·P®¦!
- Sub test()
- Dim mytbl As Range
- [a1].CurrentRegion.ClearContents
- Set mytbl = [a1].End(xlToRight).CurrentRegion
- Set myQry = [a1]
- mytbl.Columns(4).AdvancedFilter xlFilterCopy, copytorange:=myQry, unique:=True
- Set myQry = myQry.CurrentRegion
- For i = 2 To myQry.Rows.Count
- x = [aa2].End(xlToLeft).Column + 1
- With mytbl
- .AutoFilter 4, myQry.Rows(i)
- .Copy
- Cells(1, x).PasteSpecial xlPasteColumnWidths
- Cells(1, x).PasteSpecial xlPasteAll
- mytbl.AutoFilter
- End With
- Next
- End Sub
½Æ»s¥N½X [attach]14880[/attach] |
-
-
question.zip
(484.97 KB)
|
|
|
|
|
|
- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 277
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-12-23
|
¦^´_ 1# cmo140497 - Sub ex()
- Set dic = CreateObject("Scripting.Dictionary")
- Dim MyQtb As Range, VRng As Range
- Set MyQtb = Range("A1").End(xlToRight).CurrentRegion
- Application.ScreenUpdating = False
- For Each pic In ActiveSheet.Pictures
- Set a = pic.TopLeftCell.Offset(, 1)
- m = a & a.Offset(, 1)
- Set dic(a & a.Offset(, 1)) = Pictures(pic.Name)
- Next
- For Each a In Range([A2], [A2].End(xlDown))
- With MyQtb
- .AutoFilter 4, a
- Set Rng = Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
- Set VRng = .SpecialCells(xlCellTypeVisible)
- VRng.Copy
- Rng.PasteSpecial xlPasteColumnWidths
- Rng.PasteSpecial Paste:=xlPasteValues
- .AutoFilter
- r = 1
- Do Until r > Rng.Offset(, 1).End(xlDown).Row - 1
- Set c = Rng.Offset(r, 0)
- dic(c.Offset(, 1) & c.Offset(, 2)).Copy
- c.Select
- ActiveSheet.Paste
- r = r + 1
- Loop
- End With
- Next
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X |
|
¾Ç®üµL²P_¤£®¢¤U°Ý
|
|
|
|
|
- ©«¤l
- 95
- ¥DÃD
- 29
- ºëµØ
- 0
- ¿n¤À
- 150
- ÂI¦W
- 0
- §@·~¨t²Î
- windows2003
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- Kaoshiung
- µù¥U®É¶¡
- 2010-11-5
- ³Ì«áµn¿ý
- 2018-2-8
|
¦^´_ 2# Hsieh
Dear ª©¥D±z¦ :
¦³¤@¤p°ÝÃD,¤£ª¾³o¥¨¶°¬Oþ¸Ì¥X¿ù,¦A³Â·Ð±z¸Ñ¨M¤p§ÌªººÃ´b,·P®¦!
|
|
|
|
|
|
|
- ©«¤l
- 95
- ¥DÃD
- 29
- ºëµØ
- 0
- ¿n¤À
- 150
- ÂI¦W
- 0
- §@·~¨t²Î
- windows2003
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- Kaoshiung
- µù¥U®É¶¡
- 2010-11-5
- ³Ì«áµn¿ý
- 2018-2-8
|
¦^´_ 2# Hsieh
¤£¦n·N«ä,¤p§Ì¨S¦³¸ÑÄÀªº«Ü²M·¡,¤p§Ì¥ÎIÄæ¦ì§@¬°¿z¿ï±ø¥ó,¥ý¿z¿ï¥X¤£«½Æ¤§no.È©óAÄæ¦ì,¦A±NAÄæ¦ì¨Ì§Ç·íCriteria,¦A¿z¿ï±N¬Û¦P¤§no.³s¦P¹Ï¤ù,¤@°_½Æ»s¬Û¾F¤§ªÅ¥ÕÄæ¦ì
¦A³Â·Ðª©¥D¸Ñ¨M¤p§ÌªººÃ´b,ÁÂÁ±z!
|
|
|
|
|
|
|
- ©«¤l
- 95
- ¥DÃD
- 29
- ºëµØ
- 0
- ¿n¤À
- 150
- ÂI¦W
- 0
- §@·~¨t²Î
- windows2003
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- Kaoshiung
- µù¥U®É¶¡
- 2010-11-5
- ³Ì«áµn¿ý
- 2018-2-8
|
¦^´_ 3# cmo140497
¤ï¶Õ,§ä¨ì°ÝÃD¤F,AÄæ¦ì,ª©¥D¥H¬°CRITERIA¬O즳ªº,¤p§Ì¥[¤F¶i¥h,¥t¥~Pictures,¤p§Ì§ï¦¨ActiveSheet.Pictures(pic.Name)
,´N¥i¥H¤F,¤£¦n·N«ä,·PÁª©¥Dªº«ü¾É |
|
|
|
|
|
|
- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 5# cmo140497
ª½±µ½Æ»s- Option Explicit
- Sub Ex()
- Dim mytbl As Range, myQry As Range, P As Pictures, I As Integer
- Application.ScreenUpdating = False
- With Sheets("¤u§@ªí1")
- .Activate
- .[a1].CurrentRegion.ClearContents
- .Range("J1", .[J1].End(xlToRight)).EntireColumn.Clear '²M°£Â¦³¸ê®Æ (Clear µLªk§R°£¹Ï¤ù)
- Set P = .Pictures '¹Ï¤ù¶°¦X
- For I = P.Count To 1 Step -1
- If Intersect(.Range(P(I).TopLeftCell.Address), .[F:F]) Is Nothing Then '¹Ï¤ù¦ì¸m¤£¦b FÄæ
- P(I).Delete '¹Ï¤ù §R°£
- End If
- Next
- Set mytbl = .[F:I]
- Set myQry = .[a1]
- mytbl.Columns(4).AdvancedFilter xlFilterCopy, copytorange:=myQry, unique:=True
- Set myQry = myQry.CurrentRegion
- For I = 2 To myQry.Rows.Count
- With mytbl
- .AutoFilter 4, myQry.Rows(I)
- .SpecialCells(xlCellTypeVisible).Copy
- .Parent.Cells(1, .Parent.Columns.Count).End(xlToLeft).Offset(, 1).Select
- .Parent.Paste
- 'ActiveSheet.Paste
- End With
- Next
- End With
- mytbl.AutoFilter
- myQry.Select
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X |
|
|
|
|
|
|
- ©«¤l
- 95
- ¥DÃD
- 29
- ºëµØ
- 0
- ¿n¤À
- 150
- ÂI¦W
- 0
- §@·~¨t²Î
- windows2003
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- Kaoshiung
- µù¥U®É¶¡
- 2010-11-5
- ³Ì«áµn¿ý
- 2018-2-8
|
¦^´_ 6# GBKEE
·PÁª©¥Dªº«ü¾É,¤p§Ì¤S¾Ç¤F·sªº¤èªk,·P®¦! |
|
|
|
|
|
|