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

rouber590324

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

GBKEE

¦^´_ 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

rouber590324

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

rouber590324

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

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

rouber590324

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

GBKEE

¦^´_ 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

rouber590324

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