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

[µo°Ý] §ä¥X­«Âиê®Æ

¦^´_ 7# mdr0465
  1. Sub test()

  2.     Dim D As Object, R, x, k

  3.     Application.ScreenUpdating = False
  4.     [A2:A10000].EntireRow.Interior.ColorIndex = xlNone
  5.     [H2:J10000].Clear

  6.     Set D = CreateObject("Scripting.Dictionary")
  7.     For Each R In Range("D1").CurrentRegion.Columns(4).Cells
  8.         R.Interior.ColorIndex = xlNone
  9.         If Not D.Exists(R.Value) Then
  10.             Set D(R.Value) = R
  11.         Else
  12.             Set D(R.Value) = Union(D(R.Value), R)
  13.         End If
  14.     Next
  15.     [H1] = "¹q¸Ü­«ÂÐÀx¦s®æ¦ì¸m"
  16.     [I1] = "¹ïÀ³³õªº¦WºÙ"
  17.     For Each R In D.KEYS
  18.         If D(R).Cells.Count > 1 Then
  19.             D(R).EntireRow.Interior.ColorIndex = 6
  20.             For Each x In D(R)
  21.                 x¦ì¸m = ""
  22.                 x³õ¦a = ""
  23.                 For Each k In D(R)
  24.                     If x.Address <> k.Address Then
  25.                         x¦ì¸m = x¦ì¸m & "," & k.Address(0, 0)
  26.                         x³õ¦a = x³õ¦a & "," & k.Offset(0, -3)
  27.                     End If
  28.                 Next
  29.                 x.Offset(0, 4) = Mid(x¦ì¸m, 2, 99)
  30.                 x.Offset(0, 5) = Mid(x³õ¦a, 2, 99)
  31.             Next
  32.         End If
  33.     Next
  34.     Application.ScreenUpdating = True
  35. End Sub
½Æ»s¥N½X
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

        ÀR«ä¦Û¦b : ¬Ý§O¤H¤£¶¶²´¡A¬O¦Û¤v­×¾i¤£°÷¡C
ªð¦^¦Cªí ¤W¤@¥DÃD