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

¨D¨C¤ë³Ì¤j»P³Ì¤pNO¤§­pºâ

¤£ºÞ¤F, °µ­ÓÀË´úª©+¤ë³øªí+¤é³øªí:
XX20180822-1.rar (139.13 KB)

´N°µ¨ì³o¸Ì, ªá¤Ó¦h®É¶¡¤F~~

TOP

ÁÂÁª©¥D,ªü¦õ¤j¤jªºÀ°¦£.
§Æ±æ¤ä«ù!

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-8-31 08:35 ½s¿è

¦^´_ 22# s7659109

¾A¥Î  ¨D¨C¤ë³Ì¤j»P³Ì¤pNO¤§­pºâ0822¶i¶¥ª©.xlsm
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), Rng As Range, i As Integer, ii As Integer, iii As Integer, xYear As String, AB As Variant
  4.     '**¤u§@ªí1¤W¦³¤@¨Ç¨ç¼Æ°õ¦æµ{¦¡®É·|­«·s­pºâ,¼vÅT°õ¦æ³t«×.**
  5.     Application.Calculation = xlManual   '³]©w¥Nªí­pºâ¼Ò¦¡¬°¤â°Ê
  6.     With ¤u§@ªí1.Range("A1").CurrentRegion
  7.     '**Range.CurrentRegion ÄÝ©Ê ¶Ç¦^ Range ª«¥ó¡A¸Óª«¥ó¥Nªí¥Ø«eªº°Ï°ì¡C¥Ø«e°Ï°ì¬O«ü¥H¥ô·NªÅ¥Õ¦C¤ÎªÅ¥ÕÄ檺²Õ¦X¬°Ãä¬Éªº½d³ò¡C°ßŪªº
  8.         .Sort key1:=.Cells(1), key2:=.Cells(1, 2), key3:=.Cells(1, 3), Header:=xlYes
  9.         '** ¸ê®Æ±Æ§Ç
  10.     End With
  11.     With ¤u§@ªí2
  12.         .UsedRange.Clear '¤£¥²§@¾ã­Ó¤u§@ªíªº²M°£
  13.         '**Worksheet.UsedRange ÄÝ©Ê ·|¶Ç¦^ Range ª«¥ó¡A¦¹ª«¥ó¥Nªí«ü©w¤u§@ªí¤Wªº¤w¥Î½d³ò¡C°ßŪªº¡C
  14.         
  15.         '**¿z¿ï¥X ¤u§@ªí1.Range("Al:A")¤W¤£­«½ÆªºITEM¨ì.Range("A1")¤U***
  16.         ¤u§@ªí1.Range("A1").CurrentRegion.Columns(1).AdvancedFilter xlFilterCopy, "", .Range("A1"), True
  17.         '**Range.AdvancedFilter ¤èªk ®Ú¾Ú·Ç«h½d³ò¡A±q²M³æ¤¤¿z¿ï©Î½Æ»s¸ê®Æ¡C¦pªGªì©l¿ï¾Ü¬°³æ¤@Àx¦s®æ¡A«h·|¨Ï¥ÎÀx¦s®æªº¥Ø«e°Ï°ì¡C
  18.         
  19.         .Range("C1").Resize(, 2) = Array(¤u§@ªí1.[A1], ¤u§@ªí1.[D1])
  20.         .Range("C3").Resize(, 3) = Array(¤u§@ªí1.[A1], ¤u§@ªí1.[B1], ¤u§@ªí1.[D1])
  21.         Set Rng = .[a2]
  22.         xYear = Mid(¤u§@ªí1.Range("D2"), 1, Len(¤u§@ªí1.Range("D2")) - 4)  '¦~¥÷
  23.         ReDim AR(1 To Rng.End(xlDown).Row, 1 To 49)  '**ReDim ³¯­z¦¡ ¦bµ{§Ç¼h¦¸¤¤¥Î¨Ó­«·s°t¸m°ÊºA°}¦CÅܼƪºÀx¦sªÅ¶¡¡C
  24.         Do
  25.             AR(Rng.Row, 1) = Rng  '¾É¤JITEM  **.Range("A1")¤U¤£­«½ÆªºITEM**
  26.             For i = 1 To 12
  27.                 '***¿z¿ï·Ç«h****
  28.                 .Range("C2") = Rng  'ITEM
  29.                 .Range("D2") = xYear & Format(i, "00") & "*"  '¦~¥÷&¤ë¥÷
  30.                 '** ¶i¶¥¿z¿ï**
  31.                 ¤u§@ªí1.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("C1").Resize(2, 2), CopyToRange:=.Range("C3").Resize(, 3), Unique:=True
  32.              If .Range("d4") <> "" Then '¿z¿ï¥X¸ê®Æ
  33.                 AR(Rng.Row, ((i - 1) * 4) + 2) = .Range("d4")       '³Ì¤p
  34.                 If .Range("d4").End(xlDown).Row = Rows.Count Then   '¸ê®Æ¥u¦³¤@µ§
  35.                     AR(Rng.Row, ((i - 1) * 4) + 3) = .Range("d4")   '³Ì¤j
  36.                     AR(Rng.Row, ((i - 1) * 4) + 5) = 1               '­p¼Æ
  37.                 Else
  38.                     For iii = .Range("d4") + 1 To .Range("d4").End(xlDown) - 1  '²Ä¤G³Ì¤p­È TO  ²Ä¤G³Ì¤j­Èªº°j°é
  39.                         AB = Application.Match(Format(iii, "00000"), .Range(.Range("d4"), .Range("d4").End(xlDown)), 0)
  40.                         If IsError(AB) Then AR(Rng.Row, ((i - 1) * 4) + 4) = IIf(AR(Rng.Row, ((i - 1) * 4) + 4) <> "", AR(Rng.Row, ((i - 1) * 4) + 4) & ",", "'") & Format(iii, "00000")
  41.                         'AB¬O¿ù»~­È->  iii¬° "01¤¤¶¡º|±¼¸¹½X"
  42.                     Next
  43.                     AR(Rng.Row, ((i - 1) * 4) + 3) = .Range("d4").End(xlDown)           '³Ì¤j
  44.                     AR(Rng.Row, ((i - 1) * 4) + 5) = .Range("d4").End(xlDown).Row - 3   '­p¼Æ
  45.                  End If
  46.              End If
  47.             Next
  48.             '**Àˬd¤ë¥÷¶¡ªº¿òº|**
  49.             For ii = 3 To UBound(AR, 2) - 4 Step 4
  50.                 AB = AR(Rng.Row, ii)
  51.                 Do While AB + 1 < Val(AR(Rng.Row, ii + 3))
  52.                     AR(Rng.Row, ii + 1) = IIf(AR(Rng.Row, ii + 1) <> "", AR(Rng.Row, ii + 1) & ",", "'") & Format(AB + 1, "00000")
  53.                     AB = AB + 1
  54.                 Loop
  55.             Next
  56.             Set Rng = Rng.Offset(1)  '¤U¤@­Ó .Range("A1")¤U¤£­«½ÆªºITEM
  57.         Loop Until Rng = ""   'Until->µ²§ô°j°éªº±ø¥ó
  58.     .UsedRange.Clear
  59.     With .Range("A1")
  60.         .Value = "¤ë¥÷"
  61.         AR(1, 1) = "¶µ¥Ø"
  62.         For i = 1 To 12
  63.              With .Cells(1, (i - 1) * 4 + 2).Resize(, 4)
  64.                  .Merge
  65.                  .NumberFormatLocal = "00"
  66.                  .HorizontalAlignment = xlCenter
  67.                  .Value = i
  68.                 End With
  69.             For ii = 0 To 3
  70.                 AR(1, ii + ((i - 1) * 4) + 2) = Array("³Ì¤p", "³Ì¤j", "01¤¤¶¡º|±¼¸¹½X", "­p¼Æ")(ii)
  71.                 If ii <= 1 Then
  72.                     .Cells(3, ii + ((i - 1) * 4) + 2).Resize(Rng.Row - 2).NumberFormatLocal = "00000"
  73.                 End If
  74.             Next
  75.         Next
  76.         .Offset(1).Resize(UBound(AR), UBound(AR, 2)) = AR
  77.         End With
  78.     End With
  79.     Application.Calculation = xlCalculationAutomatic   '­pºâ¼Ò¦¡¬°¦Û°Ê
  80. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦UºØ«ä¸ô¡A¥i¾Ç²ß¤£¦Pªº¼gªk¡AÁÂÁÂGBKEE¤j¤j¡A¦ý¤W­±µ{¦¡½X¡AAAA 00012 ¦b2¤ëRENO 00013¶}©l¤§«e  ¡AÂk¦b1¤ëº|¸¹¡Aº|±¼½X¥¼­p¤J¡A¤Ö­p1­Ó¤F¡C
§Æ±æ¤ä«ù!

TOP

¦^´_ 24# s7659109

#23µ{¦¡½X, ¸É¤W¤F  '**Àˬd¤ë¥÷¶¡ªº¿òº|**
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

ÁÂÁÂGBKEE¤j¤j¡C
¦P¤@°ÝÃD¡A3ºØ¸Ñªk¡AÀò¯q¨}¦h¡AÁÂÁÂ3¦ì¤j¤jªºÀ°¦£¡C
§Æ±æ¤ä«ù!

TOP

        ÀR«ä¦Û¦b : ¸Ü¦h¤£¦p¸Ü¤Ö¡A¸Ü¤Ö¤£¦p¸Ü¦n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD