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

[µo°Ý] ¦p¦ó¨ú¥X¤å¦rÀÉ«ü©w¦æªº¸ê®Æ

[µo°Ý] ¦p¦ó¨ú¥X¤å¦rÀÉ«ü©w¦æªº¸ê®Æ

¦U¦ì¥ý¶i

°õ¦æ¥Ø¿ý¤U¦³«Ü¦hªº¸ê®Æ§¨, ­Y¥u·Q¨ú¥X¤å¦rÀɤ¤ªº²Ä1-3¦æ¸ê®Æ, VBA¸Ó¦p¦ó¼g?
¦pªþÀÉ»¡©ú
TEST26.rar (114.25 KB)

·Ð½Ð¥ý¶i«ü¾É, ÁÂÁÂ!

¦^´_ 1# luke
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim S As Object, F As Object, AR, I As Integer
  4.     Application.ScreenUpdating = False
  5.                 'ScreenUpdating
  6.     '¦pªG¿Ã¹õ§ó·s¥\¯à¬O¶}±Òªº«h¬° True¡CŪ/¼g Boolean¡C
  7.     'Ãö³¬¿Ã¹õ§ó·s¥i¥[§Ö¥¨¶°ªº°õ¦æ³t«×¡C³o¼Ë±N¬Ý¤£¨ì¥¨¶°ªº°õ¦æµ{§Ç¡A¦ý¥¨¶°ªº°õ¦æ³t«×¥[§Ö¤F¡C
  8.     '½Ðª`·N¡A·í¥¨¶°µ²§ô®É¡A³]©wªºScreenUpdating ÄÝ©Ê·|¶Ç¦^ True¡C
  9.    
  10.     With CreateObject("Scripting.FileSystemObject").GETFolder(ThisWorkbook.Path)
  11.                                 'FileSystemObject ª«¥ó ´y­z ´£¨Ñ¹ï¹q¸£Àɮרt²Îªº¦s¨ú¡C
  12.         I = 2           '²Ä¤G¦C¶}©l
  13.         For Each S In .SubFolders
  14.                       'SubFolders ÄÝ©Ê ´y­z ¶Ç¦^¥]§t©Ò¦³¸ê®Æ§¨ªº¤@­Ó Folders ¶°¦Xª«¥ó¡A³o¨Ç¸ê®Æ§¨¥]§t¦b¬Y­Ó¯S©wªº¸ê®Æ§¨¤¤¡A¥]¬A³]©w¤FÁôÂéM¨t²ÎÀÉÄݩʪº¨º¨Ç¸ê®Æ§¨¡C
  15.             For Each F In S.Files
  16.                            'Files ¶°¦Xª«¥ó ´y­z  ¦b¤@­Ó¸ê®Æ§¨¤ºªº©Ò¦³ File ª«¥óªº¶°¦Xª«¥ó¡C
  17.                 With Workbooks.Open(F)
  18.                      AR = .Sheets(1).[A1:A3]
  19.                     .Close 0            'ÀÉ®×Ãö³¬ ¤£¦sÀÉ
  20.                 End With
  21.                 '***Cells ¨S«ü©w¤u§@ªí->§@¥Î¤¤ªº¤u§@ªí
  22.                 Cells(I, "A") = S.Name  '¸ê®Æ§¨¦WºÙ
  23.                 Cells(I, "G").Resize(1, 3) = Application.WorksheetFunction.Transpose(AR)
  24.                 'TRANSPOSE »yªk   TRANSPOSE(array)
  25.                 'Array    ¬O¤u§@ªí©Î¥¨¶°ªí¤¤±z©Ò­nÂà¸mªº¯x°}¡C°}¦CªºÂà¸m¬O¥H °}¦Cªº²Ä¤@¦C§@¬°·s°}¦Cªº²Ä¤@Äæ¡A¦Ó°}¦Cªº²Ä 2 ¦C«h¬°·s°}¦Cªº²Ä 2 Äæ¡A¨Ì¦¹Ãþ±À¡C
  26.                 I = I + 1 '²Ä¤G¦C¶}©l ©¹¤U¥[¤@¦C
  27.             Next
  28.         Next
  29.         With Range("G:I") '***Range ¨S«ü©w¤u§@ªí->§@¥Î¤¤ªº¤u§@ªí
  30.             .Cells.Replace ";", "", LookAt:=xlPart       'Replace:´À´«¦r¦ê
  31.             .EntireColumn.AutoFit
  32.         End With
  33.     End With
  34.     Application.ScreenUpdating= True
  35.     '·í¥¨¶°µ²§ô®É¡A³]©wªºScreenUpdating ÄÝ©Ê·|¶Ç¦^ True¡C
  36. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE

ÁÂÁ¶Wª©µªÂÐ

   ·í¸ê®Æ§¨¤º¦³¨ä¥LÀɮ׮榡¦p¡u0001112¡v¸ê®Æ§¨¦³*.log©Î*.txtÀÉ
   ¦p¦ó¥u¿z¿ï¥XcsvÀɦpªþ¥ó»¡©ú


TEST26-1.rar (23.27 KB)

TOP

¦^´_ 3# luke
  1. Option Explicit
  2. Sub Ex()
  3.     Dim S As Object, F As Object, AR, I As Integer
  4.     Application.ScreenUpdating = False
  5.                 'ScreenUpdating
  6.     '¦pªG¿Ã¹õ§ó·s¥\¯à¬O¶}±Òªº«h¬° True¡CŪ/¼g Boolean¡C
  7.     'Ãö³¬¿Ã¹õ§ó·s¥i¥[§Ö¥¨¶°ªº°õ¦æ³t«×¡C³o¼Ë±N¬Ý¤£¨ì¥¨¶°ªº°õ¦æµ{§Ç¡A¦ý¥¨¶°ªº°õ¦æ³t«×¥[§Ö¤F¡C
  8.     '½Ðª`·N¡A·í¥¨¶°µ²§ô®É¡A³]©wªºScreenUpdating ÄÝ©Ê·|¶Ç¦^ True¡C
  9.     With CreateObject("Scripting.FileSystemObject").GETFolder(ThisWorkbook.Path)
  10.                                 'FileSystemObject ª«¥ó ´y­z ´£¨Ñ¹ï¹q¸£Àɮרt²Îªº¦s¨ú¡C
  11.         I = 2           '²Ä¤G¦C¶}©l
  12.         For Each S In .SubFolders
  13.                       'SubFolders ÄÝ©Ê ´y­z ¶Ç¦^¥]§t©Ò¦³¸ê®Æ§¨ªº¤@­Ó Folders ¶°¦Xª«¥ó¡A³o¨Ç¸ê®Æ§¨¥]§t¦b¬Y­Ó¯S©wªº¸ê®Æ§¨¤¤¡A¥]¬A³]©w¤FÁôÂéM¨t²ÎÀÉÄݩʪº¨º¨Ç¸ê®Æ§¨¡C
  14.             For Each F In S.Files
  15.                            'Files ¶°¦Xª«¥ó ´y­z  ¦b¤@­Ó¸ê®Æ§¨¤ºªº©Ò¦³ File ª«¥óªº¶°¦Xª«¥ó¡C
  16.                 If UCase(F) Like "*.CSV" Then  'ÀɦW(¤j¼g)¦³ "*.CSV"
  17.                            'Like  ¹Bºâ¤l ¥Î¨Ó¤ñ¸û¨â­Ó¦r¦ê
  18.                     With Workbooks.Open(F)
  19.                          AR = .Sheets(1).[A1:A3]
  20.                         .Close 0            'ÀÉ®×Ãö³¬ ¤£¦sÀÉ
  21.                     End With
  22.                     '***Cells ¨S«ü©w¤u§@ªí->§@¥Î¤¤ªº¤u§@ªí
  23.                     Cells(I, "A") = S.Name  '¸ê®Æ§¨¦WºÙ
  24.                     Cells(I, "G").Resize(1, 3) = Application.WorksheetFunction.Transpose(AR)
  25.                     'TRANSPOSE »yªk   TRANSPOSE(array)
  26.                     'Array    ¬O¤u§@ªí©Î¥¨¶°ªí¤¤±z©Ò­nÂà¸mªº¯x°}¡C°}¦CªºÂà¸m¬O¥H °}¦Cªº²Ä¤@¦C§@¬°·s°}¦Cªº²Ä¤@Äæ¡A¦Ó°}¦Cªº²Ä 2 ¦C«h¬°·s°}¦Cªº²Ä 2 Äæ¡A¨Ì¦¹Ãþ±À¡C
  27.                     I = I + 1 '²Ä¤G¦C¶}©l ©¹¤U¥[¤@¦C
  28.                 End If
  29.             Next
  30.         Next
  31.         With Range("G:I") '***Range ¨S«ü©w¤u§@ªí->§@¥Î¤¤ªº¤u§@ªí
  32.             .Cells.Replace ";", "", LookAt:=xlPart       'Replace:´À´«¦r¦ê
  33.             .EntireColumn.AutoFit
  34.         End With
  35.     End With
  36.     Application.ScreenUpdating = True
  37.     '·í¥¨¶°µ²§ô®É¡A³]©wªºScreenUpdating ÄÝ©Ê·|¶Ç¦^ True¡C
  38. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 4# GBKEE


    ÁÂÁ¶Wª©¦^ÂÐ

   °²¦p¨ú¤å¦rÀɤ¤«D³sÄòªº²Ä1¦æ, ²Ä3¦æ©M²Ä5¦æ
   À³¦p¦ó­×§ïAR = .Sheets(1).[A1:A3]»yªk

TOP

¦^´_ 5# luke
  1. Dim AR(1 To 3)
  2.     ''
  3.     ''
  4.     ''
  5.     AR(1) = .Sheets(1).[A1]
  6.     AR(2) = .Sheets(1).[A3]
  7.     AR(3) = .Sheets(1).[A5]
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD