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

[µo°Ý] ·j´M¡B¤ñ¹ï¡A¦A½Æ»s¹L¨Óªº¥\¯à

¦^´_ 5# iceandy6150
VBAªº¥i¥Î¤£¦Pªº¼gªk,¨Ó¹F¨ì¦P¤@®ÄªG
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim Rng() As Range, Ar(), xR As Variant, xC As Variant, i As Integer, ii As Integer
  4.     Dim xRng As Range
  5.     Application.ScreenUpdating = False
  6.     Ar = Array("´ú¸Õ.XLSM", "¤Ø¤o.XLSX", "¸ê®Æ.XLSX")
  7.     ReDim Rng(UBound(Ar))       '** Rng ­«¸m¤¸¯À»P Ar ¤@¼Ë¦h
  8.     For i = 0 To UBound(Ar)
  9.         '**Workbooks(Ar(0)).Path ** ­×§ï¬° ¤Ø¤o , ¸ê®Æ Àɮתº¥¿½T¸ê®Æ§¨¦ì¸m**
  10.         If i > 0 Then Workbooks.Open (Workbooks(Ar(0)).Path & "\" & Ar(i)) '**¶}±ÒÀÉ®×
  11.         With Workbooks(Ar(i))
  12.             Set Rng(i) = .Sheets(1).Range("A1").CurrentRegion   '**³]©w­ÓÀɮתº¸ê®Æ½d³ò
  13.         End With
  14.     Next
  15.     With Rng(0)                         '**´ú¸Õ.XLSM ²M°£­n¾É¤J¸ê®Æªº½d³ò
  16.         .Range(.Cells(2, 2), .Cells(.Rows.Count, .Columns.Count)) = ""
  17.     End With
  18.     Set xRng = Rng(0).Cells(2, 1)       '**´ú¸Õ.XLSM: ²Ä¤@­Ó ¾Ç¸¹
  19.     Ar = Rng(0)                         '**´ú¸Õ.XLSM: ½d³ò¸ê®Æ¾É¤J°}¦C
  20.     Do While xRng <> ""                 '°j°é: ¾Ç¸¹ªº·j´M
  21.         For ii = 1 To UBound(Rng)
  22.             xR = Application.Match(xRng, Rng(ii).Columns(1), 0) '¤Ø¤o,¸ê®Æ ¤¤·j´M ¾Ç¸¹(ªº¦C¸¹)
  23.             If Not IsError(xR) Then                             '**·j´M¨ì ¾Ç¸¹(ªº¦C¸¹)
  24.                 For i = 2 To Rng(0).Rows(1).Cells.Count         '**´ú¸Õ Äæ¦ì¦WºÙ
  25.                     '**xC ¶Ç¦^¬O§_·j´M¨ì Äæ¦ì¦WºÙ
  26.                     xC = Application.Match(Rng(0).Cells(1, i), Rng(ii).Rows(1).Cells, 0)
  27.                     If Not IsError(xC) Then Ar(xRng.Row, i) = Rng(ii).Cells(xR, xC) '**¾É¤J¸ê®Æ¨ì°}¦C
  28.                 Next
  29.             End If
  30.         Next
  31.         Set xRng = xRng.Offset(1)           '**´ú¸Õ.XLSM: ¤U¤@­Ó ¾Ç¸¹
  32.     Loop
  33.     For i = 1 To UBound(Rng)
  34.         Rng(i).Parent.Parent.Close          '**Ãö³¬ "¤Ø¤o.XLSX", "¸ê®Æ.XLSX"
  35.     Next
  36.     Rng(0) = Ar                             '**°}¦C¸ê®Æ¾É¤J´ú¸Õ.XLSMªº½d³ò
  37.     Application.ScreenUpdating = True
  38. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 7# iceandy6150

±Æ§Çªº°ÝÃD,§A¥i¥Î¿ý»s¥¨¶°½m²ß¬Ý¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim ar(), c As Integer, i As Integer
  4.     '**ReDim ³¯­z¦¡ ¦bµ{§Ç¼h¦¸¤¤¥Î¨Ó­«·s°t¸m°ÊºA°}¦CÅܼƪºÀx¦sªÅ¶¡¡C
  5.     ReDim ar(0 To 2)
  6.     For i = 0 To UBound(ar)
  7.         ar(i) = Chr(65) & i
  8.     Next
  9.     MsgBox UBound(ar) & vbLf & Join(ar, ",")
  10.     c = 8
  11.     ReDim ar(1 To c)
  12.     For i = 1 To UBound(ar) Step 2
  13.         ar(i) = Chr(66) & i
  14.     Next
  15.    
  16.     MsgBox UBound(ar) & vbLf & Join(ar, " , ")
  17.     ReDim Preserve ar(1 To c + 10)
  18.     '**  Preserve ¿ï¾Ü©Ê¤Þ¼Æ¡C·í§ïÅܭ즳°}¦C³Ì«á¤@ºûªº¤j¤p®É¡A¤´µM«O¦³­ì¨Óªº¸ê®ÆªºÃöÁä¦r
  19.     For i = c + 1 To UBound(ar) Step 3
  20.         ar(i) = i & Chr(67)
  21.    
  22.     Next
  23.     MsgBox UBound(ar) & vbLf & Join(ar, ",,")
  24.    
  25. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : §Ú­Ì³Ì¤jªº¼Ä¤H¤£¬O§O¤H¡D¥i¯à¬O¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD