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

[µo°Ý] ¦p¦óÅý¤£¦PÀɮצP¤@³f¸¹¦Û°Ê¶×¤JÁ`ªí

¦p¦ó±N©ú²Óªíªº¯S©w­È·J¾ã¨ìÁ`ªí¤¤

¦p¦ó±N©ú²ÓªíA001¡BA002¡BA003¤¤³f¸¹¬°001¶×¤JÁ`ªí¤º¡C

Book8.rar (7.77 KB)

§Æ±æ¤ä«ù!

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-9-23 16:49 ½s¿è

¦^´_ 1# s7659109
¸Õ¸Õ¬Ý
  1. Sub Ex_¯S©w­È·J¾ã¨ìÁ`ªí()
  2.     Dim xNO As String, AR(), A, Sh As Worksheet, R As Range, i As Integer, xR As Integer
  3.     xNO = InputBox("¿é¤J³f¸¹")
  4.     If xNO = "" Then Exit Sub
  5.     i = 1
  6.     For Each Sh In Sheets
  7.         If InStr(Sh.Name, "A0") = 1 Then
  8.             For Each R In Sh.Range("a1").CurrentRegion.Columns("B").Cells
  9.                 If R.Text = xNO Then
  10.                 A = Sh.Range("a1").CurrentRegion.Rows(R.Row)
  11.                 ReDim Preserve AR(1 To i)
  12.                 AR(i) = A
  13.                 i = i + 1
  14.                 End If
  15.             Next
  16.         End If
  17.     Next
  18.     If i = 1 Then MsgBox "³f¸¹: §ä¤£¨ì  " & xNO: Exit Sub
  19.     With Sheets("Á`ªí").Range("A1").CurrentRegion
  20.         .Parent.Activate
  21.         .Offset(2).Clear
  22.         .Range("A3").Resize(i - 1, UBound(A, 2)) = Application.Transpose(Application.Transpose(AR))
  23.          xR = Sheets("Á`ªí").Range("A1").CurrentRegion.Rows.Count
  24.         .Cells(3, 2).Resize(xR - 2).NumberFormatLocal = "@"
  25.         .Cells(3, 2).Resize(xR - 2).FormulaR1C1 = xNO
  26.         .Cells(xR + 1, 1) = "¦X­p"
  27.         .Cells(xR + 1, 5) = "=SUM(R[-1]C:R[-" & xR - 3 & "]C)"
  28.         .Cells(xR + 1, 5) = .Cells(xR + 1, 5)
  29.         .Cells(xR + 1, 8) = "=SUM(R[-1]C:R[-" & xR - 3 & "]C)"
  30.         .Cells(xR + 1, 8) = .Cells(xR + 1, 8)
  31.         .Cells(3, 2).Resize(xR - 2).NumberFormatLocal = "@"
  32.         .Cells(3, 2).Resize(xR - 2).FormulaR1C1 = xNO
  33.         'Rows (xR + 1)
  34.         .Rows(xR + 1).Interior.Color = vbYellow
  35.     End With
  36.     MsgBox "ok"
  37. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥i¯àª©¥D»~·|§Úªº·N«ä¤F¡A®M¥Î§Aªºµ{¦¡½X¡A¦³ÂI©_©Ç¡A
§Ú§Æ±æªºµ²ªG¬O¤u§@©³½ZA001¡BA002¡BA003¤¤ªº³f¸¹
001¦Û°Ê¶×¤JÁ`ªí¤º(¦pÁ`ªí¤ºªºµ²ªG)¡A·P·Å¡C

Book8-1.rar (8.56 KB)

§Æ±æ¤ä«ù!

TOP

¦^´_ 3# s7659109
  1. Sub Import_Data()
  2. Dim Sh As Worksheet, A As Range, Ar(), Ay(0 To 7), s&, Sn$, cnt#, cnt1#
  3. Sn = InputBox("¿é¤J¬d¸ß³f¸¹", , "001")
  4. For Each Sh In Sheets
  5. If Sh.Name Like "A*" Then
  6.    With Sh
  7.       For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants)
  8.         If A = Sn Then
  9.             For i = -1 To 6
  10.                Ay(i + 1) = A.Offset(, i)
  11.             Next
  12.            ReDim Preserve Ar(s)
  13.            Ar(s) = Ay
  14.            cnt = cnt + Ay(4)
  15.            cnt1 = cnt1 + Ay(7)
  16.            s = s + 1
  17.         End If
  18.       Next
  19.     End With
  20. End If
  21. Next
  22. With Sheet4
  23. .UsedRange.Offset(2) = ""
  24. If s > 0 Then
  25. ReDim Preserve Ar(s)
  26. Ar(s) = Array("¦X­p", "", "", "", cnt, "", "", cnt1)
  27. s = s + 1
  28. .Columns("B:B").NumberFormat = "@"
  29. .[A3].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
  30. Else
  31. MsgBox "µL²Å¦X¸ê®Æ"
  32. End If
  33. End With
  34. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

[µo°Ý] ¦p¦óÅý¤£¦PÀɮצP¤@³f¸¹¦Û°Ê¶×¤JÁ`ªí

ÅýA001ÀÉ®×»PA002Àɮפ¤ªº³f¸¹001¦Û°Ê¶×¤J°ÝÃD10
¤¤Á`ªí¤¤(¦p¤ºÅã¥Ü)¡A¨Ã¨Ì¤é´Á¦Û°Ê±Æ§Ç¡C

°ÝÃD10.rar (15.97 KB)

§Æ±æ¤ä«ù!

Á`ªí¤º¨ÌµMµL¤ÏÀ³¡A¦ó¬G¡H

Book8-2.rar (9.78 KB)

§Æ±æ¤ä«ù!

TOP

§Ú¤wªþÀÉ8-3¡Aµ{¦¡½X¤w¶K¤W¡A¦ýÁ`ªí¨ÌµM¨S¤Ï¬M
½ÐÀ°§Ú¬Ý¤@¤UªþÀÉ¡A¨º¸Ì¦³¿ù¡AÁÂÁ¡C

Book8-3.rar (9.02 KB)

§Æ±æ¤ä«ù!

TOP

¦^´_ 5# s7659109
  1. Sub ex()
  2. Dim Sn$, Fs, F, Ar()
  3. Sn = InputBox("½Ð¿é¤J¬d¸ß³f¸¹", , "001")
  4. Fs = Application.GetOpenFilename("Excel Files(*.xls),*.xls", , "½Ð¿ï¾ÜÀÉ®×(¥i½Æ¿ï)", , True)
  5. If Not IsArray(Fs) Then MsgBox "½Ð¿ï¾ÜÀÉ®×": Exit Sub
  6. For Each F In Fs
  7.    With Workbooks.Open(F)
  8.       With .Sheets(1)
  9.          For Each a In .Range("B:B").SpecialCells(xlCellTypeConstants)
  10.             If a = Sn Then
  11.                ay = a.Offset(, -1).Resize(, 8).Value
  12.                ReDim Preserve Ar(s)
  13.                Ar(s) = ay
  14.                s = s + 1
  15.             End If
  16.          Next
  17.       End With
  18.       .Close 0
  19.     End With
  20. Next
  21. With ThisWorkbook.Sheets("Á`ªí")
  22. .UsedRange.Offset(2) = ""
  23. If s > 0 Then
  24.   .[A1] = Sn
  25.   .[A3].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
  26.   Else
  27.   MsgBox "¨S¦³²Å¦X¸ê®Æ"
  28. End If
  29. End With
  30. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 7# s7659109
¥[¤WSh.
   
               If R.Text = xNO Then
10.                A = Sh.Range("a1").CurrentRegion.Rows(R.Row)
11.                ReDim Preserve AR(1 To i)
·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