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

[µo°Ý] 2003ª©µ{¦¡©ó2007ª©EXCELµLªk°õ¦æ

«ü©w¸ê®Æ§¨¦hEXCEL·J¾ã¥\¯à½Ð±Ð

DEAR ALL ¥ý¶i
  1.¦pªþ¤@¬°±N«ü©w¸ê®Æ§¨¤U¦hEXCEL·J¾ã¦Ü¦P¤@EXCEL¨Ã±N¤u§@ªí¦WºÙÅܧó¬°ÀɮצWºÙ¤§¥\¯à.
2.½Ð±Ð¦U¦ì¥ý¶i.»Ý¼W¥[¦p¤U 2¥\¯à.½Ð°Ý¦p¦ó­×§ï.·Ð¤£¥t½ç±Ð. THANKS  
   ·s¼W¥\¯à¤@ : ¦Û°Ê±N¤u§@ªí¦WºÙ©ó¦U¹ïÀ³¤u§@ªí¤§³Ì«á¤@ÄæÀx¦s®æ¤º¨q¥X.(¦³´X¦C¤º®e¦³­È¨q´X¦C)
   ·s¼W¥\¯à¤G : ¥\¯à¤@°õ¦æ«á.«Ø¥ß¤@Á`ªí.¦Û°Ê±NALL¤u§@ªí¤º®e·J¾ã©óÁ`ªí¤º(¼Ð´£¦C¶È¨q¥X¤@­Ó.¤£»Ý­«ÂÐ)
3.·Ð¤£¥t½ç±Ð    THANKS*10000

ªþ¤@
Sub yy()
  Dim a As Workbook, f$, fn$, k%
  Dim p$, Sh As Worksheet
  Set a = ThisWorkbook
  p = "C:\AAA\"
  f = Dir(p & "*.CSV")
  Application.ScreenUpdating = False
  Do While f <> ""
    Workbooks.Open p & f
    k = 0
    For Each Sh In Worksheets
      If Not IsEmpty(Sh.UsedRange) Then
      fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
      Sh.Copy after:=a.Sheets(a.Sheets.Count)
      ActiveSheet.Name = fn
      k = k + 1
      End If
    Next
    Windows(f).Close True
    f = Dir
  Loop
  Application.ScreenUpdating = True
End Sub
ù

TOP

¦^´_ 1# rouber590324
·s¼W¥\¯à¤G : ¥\¯à¤@°õ¦æ«á.«Ø¥ß¤@Á`ªí.¦Û°Ê±NALL¤u§@ªí¤º®e·J¾ã©óÁ`ªí¤º(¼Ð´£¦C¶È¨q¥X¤@­Ó.¤£»Ý­«ÂÐ)

»Ý­n§Aªº½d¨Ò

¥\¯à¤@ :¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub yy()
  3.   Dim a As Workbook, p$, f$
  4.   Set a = ThisWorkbook
  5.   p = "C:\AAA\"
  6.   f = Dir(p & "*.CSV")
  7.   Application.ScreenUpdating = False
  8.   Do While f <> ""
  9.     With Workbooks.Open(p & f).Sheets(1)  'CSV ¥u¯à¦³¤@±i¤u§@ªí
  10.        .Copy after:=a.Sheets(a.Sheets.Count)
  11.         With ActiveSheet.UsedRange
  12.             .Columns(.Columns.Count + 1) = .Parent.Name
  13.         End With
  14.      .Parent.Close True
  15.     End With
  16.     f = Dir
  17.   Loop
  18.   Application.ScreenUpdating = True
  19. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

DEAR  GBKEE ¤j¤j
·PÁ±z.µ{¦¡½T»{OK.¤p§Ì¤½¥q¸T¤î¤W¶ÇÀÉ®×......
«Ý¤p§Ì´£¥X¥Ó½Ð.¥H«á§Y¥i«Ø¥ß½d¨Ò½Ð±Ð¦U¦ì¥ý¶i
«D±`·PÁ±z¤§«ü¾É.
ù

TOP

[µo°Ý] 2003ª©µ{¦¡©ó2007ª©EXCELµLªk°õ¦æ

DEAR ALL ¤j¤j
  1 ¦pªí¤@µ{¦¡©ó2003 EXCEL®Ñ¼g«á©ó2003 °õ¦æ§¡µL°ÝÃD ,¦P¨Æ¸g¿ì¹q¸£¬°2007ª©¥»°õ¦æ«á²£¥Í¦p¤UBUG -
     1.1°õ¦æ«á¥X²{  "EXCELµLªk±N¤u§@ªí´¡¤J¥Øªº¦a¬¡·~ï,¦]¬°¥¦¥]§tªº¦C»PÄæ¤ñ¨Ó·½¬¡­¶Ã¯¤Ö,­Y­n²¾°Ê©ÎÂлs¸ê®Æ¨ì¥Øªº¦a¬¡­¶Ã¯,¥i¥H¿ï¨ú¸ê®Æ,µM«á¨Ï¥Î
         "Âлs"»P"¶K¤W"©R¥t±N¥L´¡¤J¥t¤@­Ó¬¡­¶Ã¯ªº¤u§@ªí"
     1.2 µ{¦¡²§±`³B°±©ó   Sh.Copy after:=a.Sheets(a.Sheets.Count)  ¦¹³B.
2½Ð±Ð¦U¦ì¥ý¶i ªí¤@ ¦p¦ó­×§ï¤èµL¦¹  BUG.
  2.1 ·Ð¤£§[½ç±Ð  THANKS *10000  

ªí¤@
Sub yy()
  Dim a As Workbook, f$, fn$, k%
  Dim p$, Sh As Worksheet
  Set a = ThisWorkbook
  p = "C:\AAA\"
  f = Dir(p & "*.CSV")
  Application.ScreenUpdating = False
  Do While f <> ""
    Workbooks.Open p & f
    k = 0
    For Each Sh In Worksheets
      If Not IsEmpty(Sh.UsedRange) Then
      fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
      Sh.Copy after:=a.Sheets(a.Sheets.Count)
      ActiveSheet.Name = fn
      k = k + 1
      End If
    Next
    Windows(f).Close True
    f = Dir
  Loop
  Application.ScreenUpdating = True
  
  Sheet14.Select
  Range("A1").Select
End Sub
ù

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-9-17 13:01 ½s¿è
1.1°õ¦æ«á¥X²{  "EXCELµLªk±N¤u§@ªí´¡¤J¥Øªº¦a¬¡·~ï,¦]¬°¥¦¥]§tªº¦C»PÄæ¤ñ¨Ó·½¬¡­¶Ã¯¤Ö,­Y­n²¾°Ê©ÎÂлs¸ê®Æ¨ì¥Øªº¦a¬¡­¶Ã¯,¥i¥H¿ï¨ú¸ê®Æ,µM«á¨Ï¥Îrouber590324 µoªí©ó 2014/9/16 15:12

³o¬O§i¶D§Aª©¥»¤£¦Pªº½Ä¬ð.
¨º´N¤£­n½Æ»s¾ã±i¤u§@ªí,½Æ»s¤w¨Ï¥Îªº½d³ò¨ì·s¼¨ªº¤u§@ªí.¤]¬O¤@¼Ëªº
  1. Option Explicit
  2. Sub yy()
  3.     Dim a As Workbook, f$, fn$, k%
  4.     Dim p$, Sh As Worksheet, a_Sh As Workbook
  5.     Set a = ThisWorkbook
  6.     p = "C:\AAA\"
  7.     f = Dir(p & "*.CSV")
  8.     Application.ScreenUpdating = False
  9.     Do While f <> ""
  10.         With Workbooks.Open(p & f)
  11.             k = 0
  12.             For Each Sh In .Worksheets
  13.                 If Not IsEmpty(Sh.UsedRange) Then
  14.                     fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
  15.                     'Sh.Copy after:=a.Sheets(a.Sheets.Count)
  16.                     Set a_Sh = a.Sheets.Add  '·s¼W¤@¤u§@ªí
  17.                     Sh.UsedRange.Copy a_Sh.[a1]   '½Æ»s¤w¨Ï¥Îªº½d³ò
  18.                     a_Sh.Name = fn
  19.                     k = k + 1
  20.                 End If
  21.             Next
  22.             .Close True
  23.         End With
  24.         f = Dir
  25.     Loop
  26.     Application.ScreenUpdating = True
  27.     Sheet14.Select
  28.     Range("A1").Select
  29. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

DEAR  GBKEE¤j¤j
1 °õ¦æ«á °±©ó  a_Sh.Name = fn
  ¨q¥X "½sĶ¿ù»~.µLªk¨Ï¥Î¦Ü°ßŪÄÝ©Ê."
  ½Ð°Ý¦p¦ó°£ BUG
  1.1 ·PÁ±z¤§¤£§[½ç±Ð. THANKS *10000
            Set a_Sh = a.Sheets.Add  '·s¼WÂå¤u§@ªí
                    Sh.UsedRange.Copy a_Sh.[a1]   '½Æ»s¤w¨Ï¥Îªº½d³ò
                    a_Sh.Name = fn
                k = k + 1
ù

TOP

¦^´_ 6# rouber590324
¦Û¤v¦A­×§ï¬Ý¬Ý
  1. Option Explicit
  2. Sub yy()
  3.     Dim a As Workbook, f$, fn$, k%
  4.     Dim p$, Sh As Worksheet, a_Sh As Workbook
  5.     Set a = ThisWorkbook
  6.     p = "C:\AAA\"
  7.     f = Dir(p & "*.CSV")
  8.     Application.ScreenUpdating = False
  9.     Do While f <> ""
  10.         With Workbooks.Open(p & f)
  11.             k = 0
  12.             For Each Sh In .Worksheets
  13.                 If Not IsEmpty(Sh.UsedRange) Then
  14.                     '********************************************
  15.                     '«e­±ªº f = Dir(p & "*.CSV") '¶Ç¦^*.CSVªºÀÉ®×
  16.                     '©Ò¥H f ¥²©w¬O¶Ç¦^ "*.CSV"ªº¦r§À
  17.                     fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
  18.                     '©T fn ­n±N".xls"¨ú¥N¬° "" ,¬O¤£·|¹F¨ì§Aªº´Á±æ
  19.                     '********************************************
  20.                     'Sh.Copy after:=a.Sheets(a.Sheets.Count)
  21.                     Set a_Sh = a.Sheets.Add  '·s¼W¤@¤u§@ªí
  22.                     Sh.UsedRange.Copy a_Sh.[a1]   '½Æ»s¤w¨Ï¥Îªº½d³ò
  23.                     '¥»¥DÃDªº²Ä2©«ªº²Ä9¦æµ{¦¡½X¦³µù¸Ñ
  24.                     '09.    With Workbooks.Open(p & f).Sheets(1)  'CSV ¥u¯à¦³¤@±i¤u§@ªí
  25.                     a_Sh.Name = Sh.Name  '§ï¬Ý¬Ý
  26.                     k = k + 1
  27.                 End If
  28.             Next
  29.             .Close True
  30.         End With
  31.         f = Dir
  32.     Loop
  33.     Application.ScreenUpdating = True
  34.     Sheet14.Select
  35.     Range("A1").Select
  36. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

Dear sir -
  ¨Ì±z¤§«ü¾É.­×§ï¦p¤U  ¤w¥i¥¿±`¨Ï¥Î.·PÁ±z   robert 09/18
Sub yy()
  Dim a As Workbook, f$, fn$, k%
  Dim p$, Sh, a_Sh As Worksheet

  Set a = ThisWorkbook
  p = "C:\AAA\"
  f = Dir(p & "*.CSV")
  Application.ScreenUpdating = False
  Do While f <> ""
    Workbooks.Open p & f
    k = 0
    For Each Sh In Worksheets
      If Not IsEmpty(Sh.UsedRange) Then
      fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
      Sh.Range("A1:Z500").Select
      Set a_Sh = a.Sheets.Add  '·s¼W¤@¤u§@ªí
      a_Sh.Name = fn
      Sh.UsedRange.Copy a_Sh.[a1]   '½Æ»s¤w¨Ï¥Îªº½d³ò
            ActiveSheet.Name = fn
      k = k + 1
      End If
    Next
    Windows(f).Close True
    f = Dir
  Loop
  Application.ScreenUpdating = True
  
  Sheet14.Select
  Range("A1").Select
End Sub
ù

TOP

        ÀR«ä¦Û¦b : ÁÀ¨¥¹³¤@¦·²±¶}ªºÂAªá¡A¥~ªí¬üÄR¡A¥Í©Rµu¼È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD