ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦hï¦hªí¤Ç°t¦P¦W¤u§@ªí¤¤ªº¬Û¦P¦C¼ÐÃD«á½Æ»s

[µo°Ý] ¦hï¦hªí¤Ç°t¦P¦W¤u§@ªí¤¤ªº¬Û¦P¦C¼ÐÃD«á½Æ»s

¦U¦ì«e½ú¦n!
½Ð°Ý·Q°w¹ï¸ô®|¤¤¦h¤u§@ï¤Ç°t¦P¦W¤u§@ªí¥H¤Î¬Û¦P¦C¼ÐÃD¦WºÙ«á½Æ»s¨ì·í«e¬¡­¶Ã¯¤¤­n¦p¦ó°µ??
----------------------------------------------------------------------------------------------------------
¤§«e­ã¤j´¿¤À¨É¹L¨âªí¦C¼ÐÃD¤Ç°t½Æ»sªº®×¨Ò¡A¦ýÅܦ¨¦hï¦hªí¤£ª¾¦p¦ó¾Þ§@....
¥B¦P¤u§@ªí¤U¥i¯à¥X²{¬Û¦P¦WºÙ¤§Äæ¦ì.....
¸Ô¨£½d¨ÒÀÉ¡A¤Ç°t¦P¤u§@ªí¦W¥H¤Î¦C¼ÐÃD«á½Æ»s¨ìCopy¤u§@ï¡C
(Copy-·í«e¬¡­¶Ã¯¡AWb1.Wb2.¬°¤u§@ï,¸Ì­±ªºS1,S2,S4¬°¹w­p­n½Æ»sªº¤u§@ªí,¬õ¦â¬°­«½Æ¤§¦C¦WºÙ¡C)
ÁÂÁ¤j®a!!
TEST_20240103.zip (25.24 KB)

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-1-3 16:25 ½s¿è

¦^´_ 1# shuo1125


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß¦r¨å»Pª«¥ó,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Z, PH$, FN$, i&, C As Range, xB As Workbook, S As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
For Each S In Worksheets
   For Each C In S.[1:1].SpecialCells(2): Set Z(S.Name & "|" & C) = ThisWorkbook.Sheets(S.Name).Range(C.Address): Next
Next
PH = ThisWorkbook.Path
Application.ScreenUpdating = False
Do
   If FN = "" Then FN = Dir(PH & "\*.xlsx") Else FN = Dir
   If FN = "" Then Exit Do
   'If FN = ThisWorkbook.Name Then GoTo DP
   Set xB = Workbooks.Open(PH & "\" & FN, ReadOnly:=True)
   For Each S In Worksheets
      For Each C In S.[1:1].SpecialCells(2)
         If Z.Exists(S.Name & "|" & C) = Empty Then GoTo C01
         C.EntireColumn.Copy Z(S.Name & "|" & C)
C01:  Next
   Next
   xB.Close 0
DP: Loop
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 1# shuo1125


°õ¦æ«e:


°õ¦æµ²ªG:
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483
³o¼¶¼gªº®Ä²v¸ò·Ç½T«×Åå¤H!!!
´ú¸ÕµL»~¡A·PÁÂAndy¤j¤@ª½¥H¨Óªº«ü¾É¸òÀ°¦£...

TOP

        ÀR«ä¦Û¦b : «Î¼e¤£¦p¤ß¼e¡C
ªð¦^¦Cªí ¤W¤@¥DÃD