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

[µo°Ý] VBA ¶}±Ò¦h­ÓÀÉ®× ½Æ»s¶K¤W

[µo°Ý] VBA ¶}±Ò¦h­ÓÀÉ®× ½Æ»s¶K¤W

¤j®a¦n¡A§Ú¬OVBA·s¤â¡Aª¦¤F«Ü¦h¤å«oÁÙ¬O¤£ª¾¸Ó«ç»ò§¹¦¨§Ú·Q­nªº¥\¯à
§Ú·Q°µªº¨Æ¬O:
¥´¶} "¶}ÀɶK¤W.xlsm"
1. «ö"¥[¤JÀÉ®×"ªº«ö¶s¡A¿ï¾Ü¦h­ÓÀÉ®×
2. ±N¿ï¾ÜªºÀɮ׸ô³w+ÀɮצWºÙ ¶ñ¼g¨ì AÄæ¦ì
3. «ö"°õ¦æ"«ö¶s
4. ¨t²ÎÀ°§Ú§â¨C­Ó¿ï¾ÜªºÀÉ®× ¸Ì­±ªº range(A1:C6) ¶K¨ì ¶}ÀɶK¤W.xlsmªºResult sheet

¥H¤U¬O§Úªº¥b¦¨«~¡A¤@ª½¥d¦b°õ¦æ¨ºÃä¡A§Ú¤£ª¾¹D«ç»ò¥´¶}¨C­ÓÀɮסAµM«á½Æ»s¶K¤W¡AÀÉ®×Ãö³¬¡A¦A¶}±Ò¤U¤@­ÓÀɮסAª½¨ìÀx¦s®æ = <>

Sub ¥[¤JÀÉ®×()
    With Application.FileDialog(msoFileDialogOpen)
         .InitialFileName = "D:\"
         .AllowMultiSelect = True
         .Show
         For i = 1 To .SelectedItems.Count
             Cells(i, 2) = .SelectedItems(i)
         Next
    End With
End Sub

Sub °õ¦æ()
Application.ScreenUpdating = False
For i = 1 To .SelectedItems.Count
inbook = Worksheets("Filelist").Cells(i, 2).Value
Workbooks.Open Filename:=inbook
Next
End Sub

¦^´_ 1# character

°²³]  ¥DÅé(VBA µ{¦¡½X©Ò¦b) ¬° ¥Ò   ½Æ»s½d³ò = a1~z99
³Q½Æ»sªº¥Øªº ¬°   (a1~a10ÀÉ®×)

¦b¥DÅ餺~
soae = Range("a1").CurrentRegion.Rows.Count
if  soae <>"" then
          for sh = 1 to  soae
                range("a1","z99").copy

                openfile'¶}±Ò¥ØªºÀÉ®×
               sheets("XXXX").select  '¿ï¨ú­n¶K¤Wªº¬¡­¶Ã¯
               [a1].paste
               activeworksheet.save
               activeworksheet.close
         next
endif

¤j¬ù´N¬O³o«¬ºA

  ¦h°µ¦h·Q¦h¾Ç²ß¡A¤Ö¬Ý¤Ö¿ù¤Ö°g³~

  ¦h°µ=¦h¦h½m²ß¡A¦h¦h½s¼g¡C
  ¦h·Q=·Q·Q¬°¤°»ò¤H®aµ{¦¡­n¨º¼Ë¼g¡A¦pªG´«¦¨¦Û¤v¡A¤S·|«ç¼g¡C
  ¦h¾Ç²ß=¾Ç²ß¤H®aªºµo°Ý¨Ã¸Ñµª¡A¾Ç²ß¤H®aªº¼gªk

  ¤Ö¬Ý=¥u¬Ý¤£°µ¤]ªPµM

TOP

¦^´_ 1# character
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Dim Show_File As Object
  3. Sub ¥[¤JÀÉ®×()
  4.     Dim I As Integer
  5.     Set Show_File = Application.FileDialog(msoFileDialogOpen)
  6.     With Show_File
  7.          .InitialFileName = "D:\*.xls"  '«ü©w xlsÀÉ
  8.          .AllowMultiSelect = True
  9.          .Show
  10.          If .SelectedItems.Count > 0 Then
  11.             For I = 1 To .SelectedItems.Count
  12.              Cells(I, 2) = .SelectedItems(I)
  13.          Next
  14.          End If
  15.     End With
  16. End Sub
  17. Sub °õ¦æ()
  18.     Dim I As Integer, Sh As Worksheet, Rng As Range
  19.     Set Sh = Workbooks("¶K¤W.xlsm").Sheets(1)
  20.     With Show_File
  21.         If .SelectedItems.Count > 0 Then
  22.             For I = 1 To .SelectedItems.Count
  23.                 Set Rng = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Offset(1)  'AÄæ³Ì«á¦³¸ê®Æ¦Cªº¤U¤@¦C
  24.                 With Workbooks.Open(.SelectedItems(I))
  25.                     .Sheets(1).Range("A1:C6").Copy Rng
  26.                     .Close 0
  27.                 End With
  28.             Next
  29.          End If
  30.     End With
  31.    Sh.Parent.Save   ' ¶K¤W.xlsm  ¦sÀÉ
  32. End Sub
½Æ»s¥N½X

TOP

¥ý¸ò¨â¦ì¼ö¤ßªº¤j¤j»¡ÁnÁÂÁÂ

¤p§Ì¬O·s¤âÁÙ¦b¬ã¨s¡A´ú¸Õ¹L«á¦A¤W¨Ó¦^³ø

¦A¦¸·PÁÂ! ³o¯u¬O¦n¦a¤è~~~

TOP

¦^´_ 4# character
  1. Sub ¥[¤JÀÉ®×()
  2. fds = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx), *.xls;*.xlsx", , , , True)
  3. If IsArray(fds) Then
  4. For i = 1 To UBound(fds)
  5.    [A1].Offset(i - 1) = fds(i)
  6. Next
  7. End If
  8. End Sub
  9. Sub °õ¦æ()
  10. For Each a In Range([A1], Cells(Rows.Count, 1).End(xlUp))
  11.   With Workbooks.Open(a)
  12.      .Sheets(1).[A1:C6].Copy ThisWorkbook.Sheets("Result").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  13.      .Close 0
  14.   End With
  15. Next
  16. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦n¦n¥Î §Ú­è¦n»Ý­n

¨S·Q¨ì¤§«e´N¦³Ãþ¦üªº¤å³¹¤F

¤S¾Ç¨ì¤F¤@ÂI

TOP

½Ð°Ý¦p¦ó±N¥H¤U°õ¦æÀɧ令¥i¿ï¨úÀx¦s¦b¤£¦PSHEET???
Sub °õ¦æ()
For Each a In Range([A1], Cells(Rows.Count, 1).End(xlUp))
  With Workbooks.Open(a)..............³o¸Ìªº¤p¼ga,¦bvba²z·|¸õ¦¨¤j¼gA, ¦³Ãö«Y¶Ü
    .Sheets(1).[A1:C6].Copy
     ThisWorkbook.Sheets("Result").Cells(Rows.Count,1).End(xlUp).Offset(1)
     .Close 0
  End With
Next
End Sub
Ian

TOP

        ÀR«ä¦Û¦b : «H¤ß¡B¼Ý¤O¡B«i®ð¤TªÌ¨ã³Æ¡A«h¤Ñ¤U¨S¦³°µ¤£¦¨ªº¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD