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

[¤À¨É] ±q¦h­Ó¤À­¶¸ê®Æ§â¦X¨Ö¨ì¥D­¶

[¤À¨É] ±q¦h­Ó¤À­¶¸ê®Æ§â¦X¨Ö¨ì¥D­¶

¥»©«³Ì«á¥Ñ kimbal ©ó 2010-8-3 22:06 ½s¿è

§â¤À­¶¸ê®Æ¦X¨Ö¨ì¥D­¶ªº¤èªk

³æ¯Â§âÄæ§Û¥X,¤£°µ·JÁ`.
·JÁ`ªº¸Ü, ½Ð¥ý¤F¸Ñ¤º«Ø"¼Ï¯Ãªí"©M"¦X¨Ö·JÁ`"¥Îªk

Äæ¦ì¦ì¸m¤£©ë,¦ýAÄ欰¥DÁä(¥i¤â¤u½Õ¸`),

¤À­¶¥i¥H¤£©ñÄæ¦ì.
¦pªGÄæ¦W¸ò¥D­¶¤£¤@­P,¥i¦b¥D­¶Äæ¦ìµù¸Ñ¤W¶ñ¤W,¥Î¨§¸¹¤À¹j

°£¥DÁä¥~¨ä¥LÄ椺®e¥i¥H¬°ªÅ.



Åwªï¯d·N¨£/°Q½×
  1. Option Explicit
  2.    
  3. Public Sub refresh_all()
  4.     Dim shtCurr As Worksheet
  5.     Dim rngHeader As Range, rngResult As Range, strHeaderArray, strHeader
  6.     Dim lngLastPosition As Long
  7.     With ActiveSheet
  8.         .[A1].CurrentRegion.Offset(1).Clear
  9.         lngLastPosition = 2
  10.         For Each shtCurr In Sheets
  11.             If shtCurr.Name <> .Name Then
  12.                 For Each rngHeader In .[A1].CurrentRegion.Rows(1).Cells
  13.                     If (rngHeader.Comment Is Nothing) Then
  14.                         strHeaderArray = Split(rngHeader.Value)
  15.                     Else
  16.                         strHeaderArray = Split(rngHeader.Comment.Text & "," & rngHeader.Value, ",")
  17.                     End If
  18.                     For Each strHeader In strHeaderArray
  19.                         Set rngResult = shtCurr.Rows(1).Find(strHeader, LookIn:=xlValues, LookAt:=xlWhole)
  20.                         If Not rngResult Is Nothing Then
  21.                             shtCurr.Range(rngResult.Offset(1), _
  22.                                 rngResult.Offset(rngResult.CurrentRegion.SpecialCells(xlCellTypeLastCell).Row - 1)).Copy Destination:= _
  23.                                     .Cells(lngLastPosition, rngHeader.Column)
  24.                             Exit For
  25.                         End If
  26.                     Next
  27.                 Next
  28.                 lngLastPosition = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  29.             End If
  30.         Next
  31.     End With
  32. End Sub
½Æ»s¥N½X
·PÁÂGBKEE¤j¥X¤â¬Û§U²¤Æ, ­Éªá·q¦ò, ¦A¥[¨ÇªF¦è.

2010080ConsolateAllData.zip (19.48 KB)

À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

¤µ¤éの¤@¬íは  ©ú¤éにない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

¥»©«³Ì«á¥Ñ GBKEE ©ó 2010-8-2 19:31 ½s¿è

¦^´_ 1#§â¤À­¶¸ê®Æ¦X¨Ö¨ì¥D­¶ªº¤èªk
³æ¯Â§âÄæ§Û¥X,¤£°µ·JÁ`.
kimbalªO¥D
  1. Public Sub refresh_all()
  2. Dim Sh As Worksheet, R As Range, F As Range
  3. With ActiveSheet
  4. .[A1].CurrentRegion.Offset(1).Clear
  5. For Each R In .[A1].CurrentRegion.Rows(1).Cells
  6. For Each Sh In Sheets
  7. If Sh.Name <> .Name Then
  8. Set F = Sh.Rows(1).Find(R, LookIn:=xlValues, LookAt:=xlWhole)
  9. Sh.Range(F.Offset(1), F.End(xlDown)).Copy .Cells(Rows.Count, R.Column).End(xlUp).Offset(1)
  10. End If
  11. Next
  12. Next
  13. End With
  14. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD