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

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

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2021-3-5 03:23 ½s¿è

¦^´_ 3# mdr0465

¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý¡@¬O¤£¬O§A­nªºµ²ªG¡@·PÁ¡@¡@¦³¤@­Ó°ÝÃD¡@´N¬O¸ê®Æ¤Ó¦h¡@·|µ¥«Ü¤[¡D¡D¡D¦]¬°°j°é¤Ó¦h¤F¦Ó¥B¬Oª½±µ¿é¤J¨ìÀx¦s®æ¡@¬Ý¬Ý¦³¨S¦³¤j¤j¥i¥HÀ°¦£¡@¡@

0305.rar (22.53 KB)

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2021-3-5 22:04 ½s¿è

¦^´_ 7# mdr0465

«Øij§A¥Î  ML089ª©¤j ªº­×§ï ­è¤~´ú¸Õ ¸ê®Æ¹L¦hªº¸Ü ¤£·|¤ÓºC...¦Ó¥BÅÞ¿è«Ü²M·¡
  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, 2) = "Y"

  30.                 x.Offset(0, 4) = Mid(x¦ì¸m, 2, 99)
  31.                 x.Offset(0, 5) = Mid(x³õ¦a, 2, 99)
  32.             Next
  33.         End If
  34.     Next
  35.     Application.ScreenUpdating = True
  36. End Sub
½Æ»s¥N½X

TOP

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