oak0723-1

¦^´_ 5# Andy2483


    ¤£ª¾¬°¦ó
°õ¦æ·|¥d¦bÀÉ®×002
³Â·Ð¸Ñ´b

oak0723-1

¦^´_ 5# Andy2483


    ª¾¹D¬°¦ó
°õ¦æ®É·|¥d¦í¦b002ÀÉ®×
¬Oexcelª©¥»¦]¯À¶Ü?ÁÙ¬OÀɦW¦r«¬?

Andy2483

¦^´_ 12# oak0723-1

ÁÂÁ«e½ú¦^´_
¾Ç²ß¨ìªº¸Ñ¨M¤è®×¬O»Ý±N¼Æ¦rÂà¤Æ¬°¤å¦r,¥ÎCStr()¨ç¼Æ³B²z¦¨.Sheets(CStr(Arr(i, 2)))©Î .Sheets(Arr(i, 2) & "")
https://learn.microsoft.com/zh-t ... onversion-functions
«á¾Ç¦Ò¼{¤£©P¥þ,ÁÂÁ«e½ú«üÂI
«á¾Ç¥t«Øij¥HÅܼƫŧi¬°¦r¦ê²±¸Ë¤è®×¦p¤U

Option Explicit
Sub TEST()
Dim Arr, i%, Ph$, xS As Worksheet, xB As Workbook, K%, T1$, T2$
Application.ScreenUpdating = False
Set xB = ThisWorkbook: Ph = xB.Path & "\"
Arr = Range([¶¶§Ç!E2], [¶¶§Ç!C65536].End(3))
Sheets("¶°¤¤").Cells.Clear
For i = 1 To UBound(Arr)
   T1 = Arr(i, 1): T2 = Arr(i, 2)
   On Error Resume Next
   Set xS = Workbooks(T1 & ".xlsx").Sheets(T2)
   If Err.Number <> 0 Then
      Set xS = Workbooks.Open(Ph & T1 & ".xlsx").Sheets(T2)
      K = 1
   End If
   On Error GoTo 0
   If xS Is Nothing Then
      MsgBox T1 & " ¬¡­¶Ã¯, " & T2 & " ¤u§@ªí¤£¦s¦b!µ²§ô°õ¦æ"
      Exit Sub
   End If
   xS.[A:I].Copy xB.Sheets("¶°¤¤").Cells(1, Arr(i, 3))
   If K = 1 Then xS.Parent.Close 0: K = 0
   Set xS = Nothing
Next
Set xB = Nothing: Erase Arr
End Sub

Andy2483

¦^´_ 10# singo1232001


    ÁÂÁ«e½ú

oak0723-1

¦^´_ 13# Andy2483


    ¤d¸U§O¥s§Ú«e½ú,§A¯u¬O°ª¤â
ÁÂÁ§A
¸Ñ¨M¤F
·P®¦

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
½Æ²ßªº¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Dim Arr, i%, K%, xS As Worksheet, xB As Workbook, Ph$, T1$, T2$
'¡ô«Å§iÅܼÆ:Arr¬O³q¥Î«¬ÅܼÆ,(i,K)¬Oµu¾ã¼Æ,(Ph,T1,T2)¬O¦r¦êÅܼÆ,xS¬O¤u§@ªíÅܼÆ
'xB¬O¬¡­¶Ã¯ÅܼÆ
Application.ScreenUpdating = False
'¡ô¥O¿Ã¹õ¤£ÀHµÛµ{§Ç°õ¦æµ²ªG°µÅܤÆ
Set xB = ThisWorkbook: Ph = xB.Path & "\"
'¡ô¥OxB³o¬¡­¶Ã¯ÅܼƬO ¥»ÀÉ
'¥OPh³o¦r¦êÅܼƬO¥»ÀÉ©Ò¦b¸ô®|³s±µ"\"©Ò²Õ¦¨ªº¦r¦ê
Arr = Range([¶¶§Ç!E2], [¶¶§Ç!C65536].End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H"¶¶§Ç"ªí[E2]¨ìCÄæ³Ì«á¦³¤º®eÀx¦s®æ,
'¥H³o½d³òÀx¦s®æ­È±a¤J
Sheets("¶°¤¤").Cells.Clear
'¡ô¥O"¶°¤¤"¤u§@ªí¥þ³¡Àx¦s®æ²M°£¤º®e
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!¥Oi±q1¨ì Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T1 = Arr(i, 1) & ".xlsx": T2 = Arr(i, 2)
   '¡ô¥OT1³o¦r¦êÅܼƬO i°j°é¦C²Ä1ÄæArr°}¦C­È³s±µ".xlsx"²Õ¦¨ªº¦r¦ê
   '¥OT2³o¦r¦êÅܼƬO i°j°é¦C²Ä2ÄæArr°}¦C­È¦r¦ê
   On Error Resume Next
   '¡ô¥Oµ{§Ç¤£°»¿ù
   Set xS = Workbooks(T1).Sheets(T2)
   '¡ô¥OxS³o¤u§@ªíÅܼƬO ¦W¬°(T1ÅܼÆ)¬¡­¶Ã¯¸Ì,¦W¬°(T2ÅܼÆ)ªº¤u§@ªí
   If Err.Number <> 0 Then
   '¡ô¦pªG¶Ç¦^©Î³]©w«ü©w¿ù»~ªº¼Æ­È¤£¬O 0?
   https://learn.microsoft.com/zh-t ... ic-for-applications
      Set xS = Workbooks.Open(Ph & T1).Sheets(T2)
      '¡ô¥OXSÅܼƬO¶}±ÒPhÅܼƸô®|¤U¦W¬°T1ÅܼƬ¡­¶Ã¯¸Ì,¦W¬°T2ÅܼƤu§@ªí
      K = 1
      '¡ô¥OK³oµu¾ã¼ÆÅܼƬO 1
   End If
   On Error GoTo 0
   '¡ô¥Oµ{§Ç«ì´_°»¿ù
   If xS Is Nothing Then
   '¡ô¦pªGxSÅܼƤ£¬Oª«¥ó?
      MsgBox T1 & " ¬¡­¶Ã¯, " & T2 & " ¤u§@ªí¤£¦s¦b!µ²§ô°õ¦æ": Exit Sub
      '¡ô¥O¸õ¥X´£µøµ¡~~~,µ²§ôµ{§Ç°õ¦æ
   End If
   xS.[A:I].Copy xB.Sheets("¶°¤¤").Cells(1, Arr(i, 3))
   '¡ô¥OxSÅܼƪº[A:I]Àx¦s®æ½Æ»s¨ì xB¬¡­¶Ã¯(¥»ÀÉ)"¶°¤¤"¤u§@ªíªº²Ä1¦C(«ü©wÄæ)Àx¦s®æ
   '«ü©wÄæ:i°j°é¦C²Ä3ÄæArr°}¦C­È
   If K = 1 Then xS.Parent.Close 0: K = 0
   '¡ô¦pªGKÅܼƬO1?(¥NªíxS¤u§@ªíªº¬¡­¶Ã¯¬O°õ¦æµ{§Ç¤¤¶}±Òªº),
   'True´N¥O¨äÃö³¬,¥OKÅܼÆÂk¹s
   Set xS = Nothing
   '¡ô¥OxSÅܼÆÄÀ©ñ
Next
Set xB = Nothing: Erase Arr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub