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

¾¯Å§P§O

½Ð±Ð¦U¦ì«e½ú:
³o½d¨Ò¦p¦ó¥ÎVBA¤è¦¡³B²z?
ÁÂÁ¦U¦ì«e½ú
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¬Q¤Ñ³o©«·Q¤£¨ì¤èªk,¼È®ÉÀÁ¤U,¬Q±ß¹B°Ê§¹¬ðµM·Q¨ì¥Î°Ñ·Óªí»P¸ê®Æªí¥H»²§UÄæ²V©M±Æ§Ç,´N¥i¥H©ú½Tª¾¹D¾¯Å,±N¥L¯Ç¤J¦r¨å,¦A¦R¥X¨Ó
¤µ¤Ñ¦­¤W±N¬Q±ß·Q¨ìªº¤èªk¹ê²{,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü¾É§ó¦nªº¿ìªk

°õ¦æ«e:


»²§UÄæ±Æ§Ç«á:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr(1 To 1000, 1 To 4), Crr, A(3), Y, X&, R&, i&, C%, j%, K%, P$, Q$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Range([D2], [D65536].End(3)(2)).ClearContents
'¡ô¥Oµ²ªGÄæÀx¦s®æ²M°£¤º®e
A(1) = Range([D2], [A65536].End(3))
A(2) = Range([I2], [F65536].End(3))
A(3) = Range([M2], [J65536].End(3))
'¡ô¥OAÅܼƳo ¤@ºû°}¦Cªº1~3°}¦C­È¦U¬°¤Gºû°}¦C,¦U¥HÀx¦s®æ­È±a¤J
For i = 1 To 3
   For R = 1 To UBound(A(i))
      X = X + 1
      For C = 1 To 4: Brr(X, C) = A(i)(R, C): Next
   Next
Next
'¡ô³]°j°é±N3­Ó¤Gºû°}¦C¼g¤JBrr°}¦C¸Ì
C = Range([A1], ActiveSheet.UsedRange).Columns.Count
'¡ô¥OCÅܼƬO°»´ú¨Ï¥ÎÀx¦s®æ³Ì¥kÃäÄæ¼Æ
With Cells(1, C + 1).Resize(X, 4)
'¡ô¦b¨Ï¥ÎÀx¦s®æ¥k°¼¼W³]»²§UÀx¦s®æ(¤£¼vÅT­ì©l¸ê®Æ¬°­ì«h)
   .Value = Brr
   .Sort KEY1:=.Item(1), Order1:=1, _
         Key2:=.Item(2), Order2:=1, _
         key3:=.Item(3), Order3:=2, _
         Header:=xlNo, Orientation:=xlTopToBottom
   '¡ô±N°}¦C­È¼g¤J»²§UÀx¦s®æ«á,°µ3¼h±Æ§Ç
   Crr = .Value
   '¡ô¥OCrrÅܼƬO ¤Gºû°}¦C,¸Ë¤J»²§UÀx¦s®æ±Æ§Ç«áªº­È
   For i = 1 To UBound(Crr)
   '¡ô³]¶¶°j°é!
      P = Crr(i, 1) & "|" & Crr(i, 2) & "|" & Crr(i, 3)
      '¡ô¥OP¬O1~3Äæi°j°é¦CCrr°}¦C,¥H"|"¶¡¹j²Õ¦¨ªº·s¦r¦ê
      If InStr(P, Q) <> 1 Then K = 10
      '¡ô¦]¬°¦³¨ÇÁ~¸ê¤j©ó10¯ÅÁ~¸ê,¦Ó±Æ§Ç®É¦C¦b°j°é³Ì«e­±,
      '©Ò¥H¥u­n°»´ú¨ì(©Ê½è|¾§O)¤£¦P«e¤@°j°é,´N¥ý¥OK=10

      If Crr(i, 4) <> "" Then
         Q = Crr(i, 1) & "|" & Crr(i, 2): K = Crr(i, 4)
      End If
      Y(P) = K
      '¡ô¥OP³o²Õ¦X¦r¦ê·íkey,item¬OKÅܼÆ,¯Ç¤JY¦r¨å¸Ì
   Next
   .EntireColumn.Delete
   '¡ô¥O»²§UÀx¦s®æÄæ¦ì§R°£
End With
Crr = A(1)
'¡ô¥OCrr´«¸Ë A(1)³o¤Gºû°}¦C
For i = 1 To UBound(Crr)
'¡ô³]¶¶°j°é
   P = Crr(i, 1) & "|" & Crr(i, 2) & "|" & Crr(i, 3)
   Crr(i, 1) = Y(P)
   '¡ô¥O¥HP³o²Õ¦X¦r¦ê¬dY¦r¨å±o¨ìªºitem­È¼g¤JCrr°}¦C²Ä1Äæ¸Ì,
   '¼g¦bCrr°}¦C²Ä1Ä檺­ì¦]¬O¤è«K±N°}¦C­È¼g¤JÀx¦s®æ¸Ì,
   '²¦³º²Ä1Ä檺°}¦C­È°£¤F³Q¥Î¨Ó²Õ¦X¦¨PÅܼƤ]¨S¦³¥Î³~¤F

Next
[D2].Resize(UBound(Crr), 1) = Crr
'¡ô¥OCrr°}¦C²Ä1Äæ­È¼g¤J±q[D2]¶}©lªºÀx¦s®æ¤¤
Set Y = Nothing: Erase Brr, Crr, A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¦n¨Æ­n´£±o°_¡A¬O«D­n©ñ±o¤U¡A¦¨´N§O¤H§Y¬O¦¨´N¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD