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

[µo°Ý] ¦p¦ó¤ñ¹ï¥XA/BÄæ­«½Æ¤Î¤í¯Ê¤§¼Æ­È

¦^´_ 11# loyyee
¨Ã«D¸ê®Æµ§¼Æ°ÝÃD
¬O¦pªG¨S¦³©M±ø¥óªº¸ê®Æ´N·|³y¦¨Resize¥X¿ù
  1. Sub Ex()
  2. Dim Ay(), Ay1()
  3. Set d = CreateObject("Scripting.dictionary")
  4. Set d1 = CreateObject("Scripting.dictionary")
  5. [E6].CurrentRegion.Offset(1, 0) = ""
  6. [I1].CurrentRegion.Offset(1, 0) = ""

  7. ar1 = [A1].CurrentRegion.Columns(1).Value
  8. ar2 = [A1].CurrentRegion.Columns(2).Value
  9. ar = Array(ar1, ar2)
  10. For i = 0 To 1
  11. For Each a In ar(i)
  12.    Select Case i
  13.    Case 0
  14.    If a <> "" Then d(a) = d(a) + 1
  15.    Case 1
  16.    If a <> "" Then d1(a) = d1(a) + 1
  17.    End Select
  18. Next
  19. Next
  20. dic = Array(d, d1)
  21. For i = 0 To 1
  22. For Each ky In dic(i).keys
  23. p = IIf(i = 0, 1, 0)
  24.    If dic(p).exists(ky) = False Then
  25.    ReDim Preserve Ay(s)
  26.    Ay(s) = ky
  27.    s = s + 1
  28.    End If
  29.    If dic(i)(ky) > 1 Then
  30.    ReDim Preserve Ay1(k)
  31.    Ay1(k) = ky
  32.    k = k + 1
  33.    End If
  34. Next
  35. If s > 0 Then Cells(2, 9 + i).Resize(s, 1) = Application.Transpose(Ay): s = 0: Erase Ay
  36. If k > 0 Then Cells(7, 5 + i).Resize(k, 1) = Application.Transpose(Ay1): k = 0: Erase Ay1
  37. Next
  38. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ª¾ÃÑ­n¥Î¤ßÅé·|¡A¤~¯àÅܦ¨¦Û¤vªº´¼¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD