- ©«¤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
|
¦^´_ 2# kuhsuanchieh
¸Õ¸Õ¬Ý- Option Explicit
- Sub Ex()
- Dim D As Object, AR As Variant, i As Long, XPath As String, Wb As String
- Set D = CreateObject("SCRIPTING.DICTIONARY") '¦r¨åª«¥ó
- '±N³o¨ÇÀɮצX¨Ö¼g¨ì¤@ÓÀɮ׸̡]¨Ò¦p¡GDATA¡^¡A
- '¥Ø«e¦³¼ÆÓ³sÄò½s¸¹ªºÀɮס]¨Ò¦p¡Gtest_1¡@¨ì¡@10¡^¡A
- XPath = "d:\test\ " '³]¦³¼ÆÓ³sÄò½s¸¹ªºÀɮצs©ó¦P¤@¸ê®Æ§¨
- Wb = Dir(XPath & "Test_*.xls") '¬d¸ß«ü©w©Ò»ÝªºÀÉ®×
- Application.ScreenUpdating = False
- Do While Wb <> "" '¬d¸ß¨ì©Ò»ÝªºÀÉ®×
- With Workbooks.Open(XPath & Wb).Sheets(1).UsedRange
- '¶}±ÒÀɮײĤ@Ó¤u§@ªíªº¨Ï¥Î½d³ò
- For i = 2 To .Rows.Count '²Ä2¦C¨ì³Ì«á¤@¦C
- With .Rows(i)
- AR = Array(.Cells(1, "c"), .Cells(1, "L"), .Cells(1, "D"), .Cells(1, "M"), .Cells(1, "F"))
- 'Ū¨ú C,L,D,M,F Äæ¦ì¸ê®Æ
- D(Join(AR, ",")) = "" '¼g¤J¦r¨åª«¥óªºKeyÈ
- End With
- Next
- .Parent.Parent.Close 'Ãö³¬¶}±ÒªºÀÉ®×
- '.UsedRangeªº[Parent]-> .Sheets(1)ªº[Parent] -> Workbooks
- End With
- Wb = Dir '¤U¤@Ó ¬d¸ßªºÀÉ®×
- Loop
-
- '¦p[DATA.xlsx] ¥¼¶}±Ò¥Î¤U¦¡µ{¦¡½X
- 'With Workbooks.Open(XPath & "\" & DATA.xlsx).Sheets(1)
-
- With Workbooks("DATA.xlsx").Sheets(1)
- For i = 2 To .UsedRange.Rows.Count
- AR = Application.Transpose(Application.Transpose(.UsedRange.Rows(i).Value))
- If D.exists(Join(AR, ",")) Then D.Remove Join(AR, ",")
- '¦r¨åª«¥ó Remove ¤èªk,±q¤@Ó Dictionary ª«¥ó¤¤²¾°£¤@ÓÃöÁä¦r©M¶µ¥Ø¹ï¡C
- Next
- For Each AR In D.keys '²¾°£¬Û¦PKey(ÃöÁä¦r)«á³Ñ¤UªºD.keys
- i = .[A1].End(xlDown).Row
- i = IIf(i = .Rows.Count, 2, i + 1) 'i=³Ì«á¤@¦Cªº¦C¼Æ,i=2,§_i+1
- With .Cells(i, "A").Resize(, 5)
- .Value = Split(AR, ",")
- .Cells(5).NumberFormatLocal = "[>99999999]0000-000-000;000-000-000"
- .Value = .Value '¼Æ¦r¬°¤å¦r®æ¦¡Âର¼Æ¦r®æ¦¡
- End With
- Next
- .Save '¦sÀÉ
- End With
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X |
|