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

[µo°Ý] ½Ð°ÝVBA Excel °}¦Cªº°ÝÃD?

¦^´_ 8# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:


°õ¦æµ²ªG:



Sub TEST()
Dim R&, N&, Arr, Brr, xD, T$, i&
'¡ô«Å§iÅܼÆ
Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
'¡ô¥Oµ²ªGªí¼ÐÃD¦C¥H¤U¦³¨Ï¥Îªº¦C§R°£
Arr = Sheets("Sheet1").UsedRange
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥Hªí1¦³¨Ï¥Î®æÂX®i³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Brr(1 To UBound(Arr), 1 To 8)
'¡ô¥OBrrÅܼƬO ¤GºûªÅ°}¦C(Áa¦V½d³ò¦PArr°}¦C,¾î¦V1~8)
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxDÅܼƬO ¦r¨å
For i = 3 To UBound(Arr)
'¡ô³]¶¶°j°é
    If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
    '¡ô¦pªG²Ä(4,7,8,10)Äæ°j°é¦CArr°}¦C­È¥ô¤@­Ó¬OªÅªº,´N¸õ¨ì¼Ð¥Ü 101¦ì¸mÄ~Äò°õ¦æ
    T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
    '¡ô¥OTÅܼƬOArr°}¦C­Èªº²Õ¦X¦r¦ê
    R = xD(T)
    '¡ô¥ORÅܼƬO TÅܼƬdxD¦r¨åitem­È
    If R = 0 Then
    '¡ô¦pªGRÅܼƬO 0(ªì©l­È:¥NªíTÅܼƥi¯à¬Oªì¦¸¯Ç¤J¦r¨å)
       N = N + 1: R = N: xD(T) = N
       '¡ô¥ONÅܼƲ֥[1,¥ORÅܼƬO NÅܼƭÈ(©ñµ²ªG¦bBrr°}¦Cªº¦C¸¹),
       '¥O¦bxD¦r¨åªºTÅܼÆkey,¹ïÀ³ªºitemÅܦ¨ NÅܼƭÈ

       Brr(R, 1) = Arr(i, 7)
       Brr(R, 2) = Arr(i, 8)
       Brr(R, 3) = Arr(i, 10)
       Brr(R, 7) = Arr(i, 4)
       Brr(R, 8) = Split(T, "|")(0)
       '¡ô¥OArr°}¦C­È¼g¤JBrr°}¦C¤¤
    End If
    If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
    If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
    If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
    '¡ô¦pªGArr°}¦C­È½T»{¬O«D0ªº¼Æ­È? True´Nµ¹Brr°}¦C¥[Á`
101: Next i
If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
'¡ô¦pªGªí1¦³²Å¦X±ø¥óªº¸ê®Æ? ¬O´N¥O±qªí2ªº[A2]¶}©lªº½d³ò¼g¤JBrr°}¦C­È,
'¶W¹L½d³òªº°}¦C­È©¿²¤

End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i®É¤é²öªÅ¹L¡j¤@­Ó¤H¦b¥@¶¡°µ¤F¦h¤Ö¨Æ¡A´Nµ¥©ó¹Ø©R¦³¦hªø¡C¦]¦¹¥²¶·»P®É¶¡Ävª§¡A¤Á²ö¨Ï®É¤éªÅ¹L¡C
ªð¦^¦Cªí ¤W¤@¥DÃD