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

[µo°Ý] ½Æ»s·j´M«ü©w¦WºÙ¤u§@ªí

[µo°Ý] ½Æ»s·j´M«ü©w¦WºÙ¤u§@ªí

¥»¤H·Q·j´M¤@­ÓexcelÀɤº, «ü©wªº¤u§@ªí¤¤, ¥u·Q·j´M©Ò¦³¦WºÙ¬O "Script_*ªº¤u§@ªí, ¦A¥u±i A¦C¤¤ªº¥þ³¡­È, ¦X¨Ö½Æ»s¨ì¤@±i·sªº¤u§@ªí¤¤.....¦pA¦C¬OªÅ®æ, ´N¤£½Æ»s, ¥u½Æ»s¦³­Èªº®æ¼Æ...

¦ý¦Û¤vªºvba¤£ª¾¦p¦ó·j´M«ü©w¦WºÙ¤u§@ªí, ¥u¯à¼g¥X¥þ³¡¤u§@ªí³£½Æ»s....

§Æ±æ°ª¤â­ÌÀ°¦£§ï¤@¤U, ¥ýÁÂÁÂ.

Excel_combine.zip (25.63 KB)

¨Ò

°Ñ¦ÒÀÉ//¸ô®|¶·¦Û¦æ§ó§ï
TEMP001.rar (33.06 KB)

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-13 11:57 ½s¿è

¦^´_ 1# rcyw
¦^´_ 2# ­ã´£³¡ªL

ÁÂÁ rcyw«e½úµoªí¦¹¥DÃD»P½d¨Ò,ÁÂÁ ­ã´£³¡ªL«e½ú½d¨Ò«ü¾É
¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

Sub combine()
Dim Arr, Brr, PH$, FN$, xB As Workbook, xS As Worksheet, i&, N&
'¡ô«Å§iÅܼÆ!(Arr,Brr)¬O³q¥Î«¬ÅܼÆ,(PH,FN)¬O¦r¦êÅܼÆ,xB¬O¬¡­¶Ã¯ÅܼÆ,
'xS¬O¤u§@ªíÅܼÆ,(i,N)¬Oªø¾ã¼ÆÅܼÆ

ReDim Brr(1 To 60000, 0)
'¡ô«Å§iBrr¬°¤Gºû°}¦C,°}¦C¤j¤p:Áa¦V±q1¯Á¤Þ¸¹¦C ¨ì60000¯Á¤Þ¸¹¦C,
'¾î¦V±q0¯Á¤Þ¸¹Äæ ¨ì 0¯Á¤Þ¸¹Äæ

Application.ScreenUpdating = False
'¡ô¥O¿Ã¹õ¼È¤£ÀHµ{¦¡°õ¦æ§@ÅܤÆ
PH = ThisWorkbook.Path & "\TEST"
'¡ô¥OPH³o¦r¦êÅܼƬO ¥»Àɮתº§¹¾ã¸ô®|¦r¦ê³s±µ "\TEST" ªº·s¦r¦ê
'https://learn.microsoft.com/zh-tw/office/vba/api/excel.workbook.path

FN = Dir(PH & "\*.xls*")
'¡ô¥ODir ¨ç¼Æ¦^¶Ç (¸ô®|»PÀÉ®×Ãþ«¬:PHÅܼƳs±µ "\*.xls*" )µ¹FN³o¦r¦êÅܼÆ
Do While FN <> ""
'¡ô³]±ø¥ó°j°é!·íFNÅܼƤ£¬OªÅ¦r¤¸®É,Ä~Äò°õ¦æ
   Set xB = Workbooks.Open(PH & "\" & FN)
   '¡ô¶}±Ò(PHÅÜ¼Æ ³s±µ "\" & FNÅܼƲզX¦¨ªº·s¦r¦ê¸ô®|ÀÉ®×,¨Ã¥OxB³o¬¡­¶Ã¯ÅܼƬO¥L
   For Each xS In xB.Sheets
   '¡ô³]³v¦¸°j°é!¥OxS³o¤u§@ªíÅܼƬO xBÅܼƸ̪º¤u§@ªí
       If xS.Name Like "Script_*" = False Then GoTo x01
       '¡ô¦pªGxSÅܼƪº¦W¦r¤£¬O ¥H "Script_" ¶}ÀYªº¦r¦ê!´N¸õ¨ì x01¼Ð¥Ü³BÄ~Äò°õ¦æ
       Arr = Range(xS.[a1], xS.Cells(Rows.Count, 1).End(3)(2))
       '¡ô¥OArr³o³q¥Î«¬ÅܼƬO xSÅܼÆ[A1]¨ìAÄæ³Ì«á¤@¦³¤º®eÀx¦s®æªº¤U¤@®æ(ªÅ¥Õ®æ),
       '¥H³o½d³òÀx¦s®æ­È­Ë¤J ³oArr¤Gºû°}¦C¸Ì

       For i = 1 To UBound(Arr) - 1
       '¡ô³]¶¶°j°é!i±q1¨ì Arr°}¦CÁa¦V¯Á¤Þ¦C¸¹ -1
           If Arr(i, 1) <> "" Then N = N + 1: Brr(N, 0) = Arr(i, 1)
           '¡ô¦pªGi°j°é¦C/²Ä1ÄæArr°}¦C­È¤£¬OªÅ¦r¤¸!´N¥ON³oªø¾ã¼ÆÅܼƲ֥[1,
           '¥ONÅܼƦC0¯Á¤Þ¸¹Äæ Brr°}¦C­È¬O i°j°é¦C/²Ä1ÄæArr°}¦C­È

       Next i
x01: Next
   xB.Close 0
   '¡ô¥OxBÅܼÆ,¤£Àx¦sÃö³¬
   FN = Dir
   '¡ô¥OFNÅܼƬO Dirªº¤U¤@­Ó¶µ¥Ø
Loop
Set xB = Nothing: Set xS = Nothing
'¡ô¥O³o¨â­Óª«¥óÅܼƲMªÅ
'=============================

ThisWorkbook.Activate
'¡ô¥O¦^¨ì¥»ÀÉ
If N = 0 Then Exit Sub
'¡ô¦pªGNÅܼƬO 0!´Nµ²§ôµ{¦¡°õ¦æ
Application.DisplayAlerts = False
'¡ô¥O¤£­n¦A¸õ¥X´£¥Ü:°Ý¤u§@ªí¬O¤£¬O­n§R°£!´Nª½±µ§R°£!¤£­n¦A°Ý¤F!
'https://learn.microsoft.com/zh-tw/office/vba/api/excel.application.displayalerts

On Error Resume Next
'¡ô¥O±q¦¹³B¶}©lªºµ{§Ç¹J¨ì¿ù»~®É¤£­n°»¿ù!¸õ¹L¸Óµ{§ÇÄ~Äò°õ¦æ
Sheets("Combine").Delete
'¡ô¥O "Combine"¤u§@ªí§R°£
On Error GoTo 0
'¡ô¥Oµ{§Ç±q¦¹³B¶}©l«ì´_°»¿ù
With Worksheets.Add(After:=Sheets(Sheets.Count))
'¡ô¥H¤U¬OÃö©ó¦b³Ì«á·s¼W¥[¤@­Ó¤u§@ªí«áªºµ{§Ç
     .[a1].Resize(N) = Brr
     '¡ô¥O·s¼W¤u§@ªíªº[A1]ÂX®i¦V¤UN¦Cªº½d³òÀx¦s®æ­È,¥HBrr°}¦C­È­Ë¤J
     .Name = "Combine"
     '¡ô¥O·s¼W¤u§@ªíªº¦W¦r¬O "Combine"
End With
Sheets(1).Select
'¡ô¿ï¨ú²Ä1­Ó¤u§@ªí
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# ­ã´£³¡ªL


    ÁÂÁ«e½ú

Arr = Range(xS.[a1], xS.Cells(Rows.Count, 1).End(3)(2))
¬O¬°¤F³B²z²Å¦X±ø¥óªºªÅ¥Õ¤u§@ªí

¦]¦¹°j°é»Ý­n -1
For i = 1 To UBound(Arr) - 1
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ ­ã´£³¡ªL ªº¦^ÂÐ, ¯uªº±o¯q¤£¤Ö....

¥t¥~Andy2483..§Aªºµù¸Ñ¤]«Ü¥Î¤ß...¤j®a¤]¬O¤@»ô¾Ç²ß¤¤.

TOP

¦^´_ 2# ­ã´£³¡ªL

­ã´£³¡ªL¤j¤j....¥Î¤½¥q¤¤ªºÀɮ׸դF¤@¤U, ·j´M®É¦n¹³°±¤î¤F, ¦Û¤v¬Ý¤@¤U¤£ª¾¦p¦ó­×§ï, ¥i§_À°¦£¬Ý¤@¤U, ¥ýÁÂÁÂ...

ªþ¥ó¼ÒÀÀ¤@¤U¤½¥q¤¤ªºÀÉ®×...³£¬O¥u·Q·j´M¦WºÙ¬O "Script_*ªº¤u§@ªí, ¦A¥u±N A¦C¤¤ªº¥þ³¡­È¦X¨Ö½Æ»s¨ì¤@±i·sªº¤u§@ªí¤¤.

combine.zip (134.68 KB)

TOP

¦^´_ 6# rcyw

ÁÂÁ«e½ú
1.¤U¸ü½d¨ÒÀÉ°µ´ú¸Õ,µo²{¤F¤@­Ó¿ù»~­È,«Øij«e½ú¤U¹Ï¤ù¤¤ªº¿ù»~­È¬O¸Ó­×¥¿©Î§R°£
2.«á¾Ç§R°£¿ù»~­È«á°µ´ú¸Õ¬O¨S°ÝÃDªº
3.¯¬ ¦³¬ü¦nªº¤@¤Ñ
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 7# Andy2483

¥ýÁÂÁÂAndy2483¥S.
¦b¤½¥qªº¤u§@ªí¤¤¦³®É·|¥X²{ "#N/A"...¥i§_±N³o­Ó­È¤£½Æ»s¸õ¹L´N¥i¥H¤F...

TOP

¦^´_ 8# rcyw


    ÁÂÁ«e½ú¦A¦^´_
¸Õ­×§ï¦p¤U,½Ð«e½ú¦A¸Õ¸Õ¬Ý

Sub combine()
Dim Arr, Brr, PH$, FN$, xB As Workbook, xS As Worksheet, i&, N&
ReDim Brr(1 To 60000, 0)
Application.ScreenUpdating = False
PH = ThisWorkbook.Path & "\TEST"
FN = Dir(PH & "\*.xls*")
Do While FN <> ""
   Set xB = Workbooks.Open(PH & "\" & FN)
   For Each xS In xB.Sheets
       If xS.Name Like "Script_*" = False Then GoTo x01
       With Range(xS.[a1], xS.Cells(Rows.Count, 1).End(3)(2))
          On Error Resume Next
          With .SpecialCells(xlCellTypeConstants, 16)
              Application.Goto .Cells: MsgBox "­×¥¿¿ù»~": Exit Sub
             '¡ô«ØijÀˬd/­×¥¿ ¸ê®ÆÀÉ¿ù»~­È¦sÀÉÃö³¬«á¦A­«·s°õ¦æ
              '¸ê®ÆÀɪº¿ù»~®æ°l¨s¨ä­ì¦]¬O«Ü­«­nªº
              '.ClearContents
              '¡ô¤£«Øijª½±µ²M°£¸õ¹L

          End With
          On Error GoTo 0
       Arr = .Value
       End With
       For i = 1 To UBound(Arr) - 1
           If Arr(i, 1) <> "" Then N = N + 1: Brr(N, 0) = Arr(i, 1)
       Next i
x01: Next
   xB.Close 0
   FN = Dir
Loop
Set xB = Nothing: Set xS = Nothing
'=============================
ThisWorkbook.Activate
If N = 0 Then Exit Sub
Application.DisplayAlerts = False
On Error Resume Next: Sheets("Combine").Delete: On Error GoTo 0
With Worksheets.Add(After:=Sheets(Sheets.Count))
     .[a1].Resize(N) = Brr
     .Name = "Combine"
End With
Sheets(1).Select
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 9# Andy2483

ÁÂÁÂAndy2483¥Sªº­×§ï¡A..¥Î clearcontents...¤w¥i¥Î¤F¡A¯uªº«D±`·PÁ¡C

TOP

        ÀR«ä¦Û¦b : ¹ï¤÷¥À­nª¾®¦¡A·P®¦¡B³ø®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD