- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-17 14:55 ½s¿è
¦^´_ 1# wayne0303
¦^´_ 39# ã´£³¡ªL
ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¥H¤U¬O¾Ç²ß¤ß±oµù¸Ñ,½Ð«e½ú¦A«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Sub TEST_A1()
Dim Arr, A, V, xD, T$, PH$, FN$, X%
Dim xB As Workbook, xS As Worksheet, xU As Range, xR As Range
'¡ô«Å§iÅܼÆ:(Arr,A,V,xD)¬O³q¥Î«¬ÅܼÆ,(T,PH,FN)¬O¦r¦êÅܼÆ,X¬Oµu¾ã¼ÆÅܼÆ
'xB¬O¬¡¶Ã¯ÅܼÆ,xS¬O¤u§@ªíÅܼÆ,(xU,xR)¬OÀx¦s®æÅܼÆ
PH = ThisWorkbook.Path & "\"
'¡ô¥OPH³o¦r¦êÅܼƬO ¥»ÀÉ©Ò¦b¸ê®Æ§¨¦WºÙ³s±µ"\"²Õ¦¨ªº·s¦r¦ê
FN = "°Ñ¼Æ¹ï·Óªí.xls"
'¡ô¥OFN³o¦r¦êÅܼƬO "°Ñ¼Æ¹ï·Óªí.xls"¦r¦ê
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
'ÀˬdÀɮ׬O§_¤w¤â°Ê¶}±Ò¤¤
'¡ô¥Oµ{§Ç°õ¦æ¹J¨ì¿ù»~®É,´N¸õ¨ì¤UÓµ{§ÇÄ~Äò°õ¦æ
'¥OxB³o¬¡¶Ã¯ÅܼƬO ¦W¦r¬°FNÅܼƪº ¬¡¶Ã¯,
'¦pªGFN("°Ñ¼Æ¹ï·Óªí.xls")³o¬¡¶Ã¯¨S¦³³Q¶}±Ò®É,xBÅܼƴN§ì¤£¨ì³oÀÉ®×,
'µ{§Ç´N·|²£¥Í¿ù»~
'(³o¬O¬°¤F·í¸ÓÀɮ׳Q¶}±Ò®É,°õ¦æ¸Óµ{¦¡¯à¶¶§Q¶i¦æ)
'On Error GoTo 0:¥O«ì´_µ{§Ç°»¿ù
If xB Is Nothing Then
'YÀɮש|¥¼¶}±Ò, ¥Ñµ{¦¡¶}±Ò
'¡ô¦pªGxBÅܼÆÁÙ¨S¦³¯Ç¤Jª«¥ó(¬¡¶Ã¯ÁÙ¨S³Q¶}±Òªº·N«ä)?
If Dir(PH & FN) = "" Then MsgBox "«ü©wÀɮפ£¦s¦b! ": Exit Sub
'¡ô¦pªG¥HPHÅܼƳs±µFNÅܼƲզ¨ªº·s¦r¦ê,¥HDir¨ç¼Æ¦^¶ÇȬOªÅ¦r¤¸?
'´N¸õ¥X´£µøµ¡"~~~",µM«á«ö½T©wµ²§ôµ{¦¡°õ¦æ
Application.ScreenUpdating = False
'¡ô¥O¿Ã¹õµe±¼È®É¤£ÀHµ{§Ç°õ¦æ§@µ²ªGªºÅܤÆ
Set xB = Workbooks.Open(PH & FN)
'¥Ñµ{¦¡¶}±ÒÀÉ®×
'¡ô¥O¥HPHÅܼƳs±µFNÅܼƲզ¨ªº·s¦r¦ê(¸ô®|+ÀɦW+°ÆÀɦW)¶}±ÒÀÉ®×
X = 1
'YÀɮץѵ{¦¡¶}±Òªº, X¼Ð¥Ü¬°1
'¡ô¥OX³oµu¾ã¼ÆÅܼƬO 1
End If
Set xU = xB.Sheets("¤u§@ªí1").[a2:az999]
'¡ô¥OxU³oÀx¦s®æÅܼƬO xB¬¡¶Ã¯¤¤ ¦W¬°"¤u§@ªí1"¤u§@ªí,
'¤u§@ªí¤¤ªº[a2:az999]Àx¦s®æ (ª«¥óÅܼÆ)
'---------------------------------
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD³o³q¥Î«¬ÅܼƬO ¦r¨å
For Each A In Array("¥Ås", "¥kÁ³±Û", "¥ªÁ³±Û")
'¡ô³]³v¶µ°j°é!¥OA³o³q¥Î«¬ÅܼƬO °}¦CȤ§¤@,
'°}¦CÈ:"¥Ås", "¥kÁ³±Û", "¥ªÁ³±Û"³o¤TÓ¦r¦ê
For Each xR In xU.Find(A, Lookat:=xlWhole).Resize(1, 100)
'¡ô³]¤º³v¶µ°j°é!¥OxR³oÀx¦s®æÅܼƬO xUÅܼƪºFind()¦^¶ÇÀx¦s®æ,
'¦V¥kÂX®i100®æ½d³òªºÀx¦s®æ
'PS.xUÅܼƪºFind()¦^¶ÇÀx¦s®æ:¥HAÅܼƶ¶³v®æ·j´MxUÅܼƸÌ,
'Àx¦s®æ¤º®e¥þ¦PAÅܼƪºÀx¦s®æ (xlWhole¬O¥þ¦P,xlPart¬O¥]§t¦P)
If xR(3) <> "" Then xD(V & xR(3)) = xR(2)
'¡ô¦pªGxRÅܼƺâ°_ªº²Ä3®æȤ£¬O ªÅ¦r¤¸!
'´N¥O¥HV³o³q¥Î«¬ÅܼƳs±µ xRÅܼƺâ°_ªº²Ä3®æÈ·íkey,
'item¬O xRÅܼƺâ°_ªº²Ä2®æȯǤJxD¦r¨å¸Ì
Next
V = V + 1
'¡ô¥OV³o³q¥Î«¬ÅܼƲ֥[1
Next
If X = 1 Then xB.Close 0
'YÀɮץѵ{¦¡¶}±Òªº, «h¦Û°ÊÃö³¬¥¦
'¡ô¦pªGXÅܼƬO 1!´N¥OxBÅܼÆ(°Ñ¼Æ¹ï·Óªí.xlsÀÉ®×)¤£¦sÀÉÃö³¬
'¦pªGµ{¦¡°õ¦æ«e´N¤w¸g¶}±Òªº,«h¤£·|Ãö³¬ÀÉ®×
Set xB = Nothing
'¡ô¥OxBÅܼÆÄÀ©ñ±¼ª«¥ó
'---------------------------
Arr = Range([a1], [a65536].End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,
'¥H[A1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ¤§¶¡ªºÀx¦s®æȱa¤J°}¦C¤¤
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
T = Replace(Replace(Arr(i, 1), "¢X", ""), "¥õ¨¤", "/")
'¡ô¥OT³o¦r¦êÅܼƬO i°j°é¦C²Ä1ÄæArr°}¦Cȸg¹L¨â¦¸¤å¦r¸m´«ªº·s¦r¦ê,
'²Ä1¦¸¸m´«:"¢X" ´« ""
'²Ä2¦¸¸m´«:"¥õ¨¤" ´« "/"
T = Split(Replace(Replace(T, "RR", "1R"), "LR", "2R") & "Âà", "Âà")(0)
'¡ô¥OTÅܼƬO Split()¥H "Âà"¦r¤¸¤À³Î (TÅܼƸg¹L¨â¦¸¸m´«¦r¦ê«áªº·s¦r¦ê),
'¤À³Î«áªº¤@ºû°}¦C¤¤²Ä0¯Á¤Þ¸¹°}¦CÈ
'²Ä1¦¸¸m´«:"RR" ´« "1R"
'²Ä2¦¸¸m´«:"LR" ´« "2R"
'³o¨âÓ¸m´«¬O¥²»Ý»P¦r¨åkey¹ï·Óªº:1¬O¥kÁ³±Û,2¬O¥ªÁ³±Û
'PS:¸m´««áªº¦r¦ê«á¤è³s±µ "Âà"¦¨·s¦r¦ê«á¤~¤À³Î!
'«á¾Ç¦n¹³ª¾¹D¬°¤°»ò¤F:
'¬°¤F¸U¤@T¸Ì¨S¦³ "Âà"¦r,«ü¦Vªº°}¦C©Ò¤Þ¸¹¬O(1),
'·|³y¦¨¿ù»~(°}¦C¯Á¤Þ¶W¥X½d³ò)
'³s±µ "Âà"«á¤À³Îªº°}¦C³Ì«á¤@ÓȬOªÅ¦r¤¸,³Q¤Þ¥Î¤]¤£¼vÅT¨äµ²ªG
'©Ò¥H¾i¦¨²ßºD:¦b¤À³Î«e©ó¨ä¥Ø¼Ð¦r¦ê«á¤è¦h¥[¤@Ó¤À³Î¦r
Arr(i, 1) = xD(T)
'¡ô¥Oi°j°é¦C²Ä1ÄæArr°}¦CȬO TÅܼƦbY¦r¨å¸ÌªºitemÈ
Next i
[b1].Resize(UBound(Arr)) = Arr
'¡ô¥O[B1]ÂX®i¦V¤UArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼ÆÀx¦s®æÈ,¥HArr°}¦Cȱa¤J
End Sub |
|