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

[µo°Ý] ¬Û¦P¸ê®Æ¤§¯S©wÄæ¦ì²Ä¤Gµ§¸ê®Æ¥Î¥L­È¨ú¥N

[µo°Ý] ¬Û¦P¸ê®Æ¤§¯S©wÄæ¦ì²Ä¤Gµ§¸ê®Æ¥Î¥L­È¨ú¥N

¥ý¶i±z¦n
¸ê®Æ±Æ§Ç«á¡A´X­Ó¯S©wÄæ¦ì¤§¸ê®Æ¬Û¦PªÌ¡A¥u«O¯d©T©wÄæ¦ì²Ä¤@µ§¸ê®Æ¡A²Ä¤Gµ§¥H«á¥Î0­È¨ú¥N¡C
±N©T©wÄæ¦ìµ¥©ó0ªÌ¡A¾ã¦C¶ñº¡¶À¦â¡C
¦pªþÀɤº»¡©ú
ÁÂÁ«ü¾É

B1.rar (8.73 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

¦^´_ 1# b9208
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim DataBase As Range, I As Integer, D As Object, D_Item As Variant
  4.     Set D = CreateObject("SCRIPTING.DICTIONARY")                            '¦r¨åª«¥ó
  5.     With Sheets("¤u§@ªí1")
  6.         Set DataBase = .Range("A5").Resize(.[B5].End(xlDown).Row - 4, 9)    '¨î©w½d³ò
  7.     End With
  8.     With DataBase
  9.         .Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header:=xlYes
  10.                                                                              '±Æ§Ç
  11.         For I = 1 To .Rows.Count
  12.             If Not D.EXISTS(Application.Phonetic(.Rows(I))) Then
  13.                 Set D(Application.Phonetic(.Rows(I))) = .Rows(I)             ''¦r¨åª«¥óªº¤º®e: ¬°Range
  14.             Else
  15.                 Set D(Application.Phonetic(.Rows(I))) = Union(D(Application.Phonetic(.Rows(I))), .Rows(I))
  16.                                                        'Union ¤èªk ¶Ç¦^¨â­Ó©Î¦h­Ó½d³òªº¦X¨Ö½d³ò¡C
  17.             End If
  18.         Next
  19.         For Each D_Item In D.ITEMS                     '¨Ì§Ç¶Ç¦^ ¦r¨åª«¥óªº¤º®e
  20.             With D_Item                                '¦r¨åª«¥óªº¤º®e: ¬°Range
  21.                 If .Rows.Count > 1 Then                '
  22.                     For I = 2 To .Rows.Count           '±q²Ä2¦C¶}©l
  23.                         .Rows(I).Interior.Color = vbYellow
  24.                         .Rows(I).Cells(4) = 0
  25.                         .Rows(I).Cells(4).Font.Color = vbRed
  26.                     Next
  27.                 End If
  28.             End With
  29.         Next
  30.     End With
  31. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE
ÁÂÁª©¥D
°õ¦æok
¤£¤F¸ÑExists & Phonetic ¨ç¼Æ¡A¤Wºô¬d¤]¤£¸Ñ¡C
¤£ª¾¹D¤U­±¥y¤l§t¸q
If Not D.EXISTS(Application.Phonetic(.Rows(I))) Then
     Set D(Application.Phonetic(.Rows(I))) = .Rows(I)
  Else
     Set D(Application.Phonetic(.Rows(I))) = Union(D(Application.Phonetic(.Rows(I))), .Rows(I))
End If
¥H¤WÁÂÁÂ
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 3# b9208
±Æ§Ç½d³ò¡G
¥ª¤W¨¤[A6]¡A¥k¤U¨¤¬°¤£©wºâ¡A¨Ì·Ó¸ê®Æ¦Ó©w( ¥i¯à¥]§tªÅ¥Õ¦C©ÎÄæ¡^
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 3# b9208
¤£©ú¥Õªº¨ç¼Æ,¤èªk,ÄÝ©Ê,¥i¦bµ{¦¡½X¤¤¥Î·Æ¹«¿ï¨ú«á,«öF1¬d¬Ý»¡©ú
¦^´_ 4# b9208
µ{¦¡½X¶·­×§ï¦p¤U
  1. Option Explicit
  2. Sub Ex()
  3.     Dim DataBase As Range, I As Integer, D As Object, D_Item As Variant
  4.     Dim W As String
  5.     Set D = CreateObject("SCRIPTING.DICTIONARY")                            '¦r¨åª«¥ó
  6.     With Sheets("¤u§@ªí1")
  7.         Set DataBase = .Range("A5").Resize(.[B5].End(xlDown).Row - 4, 9)    '¨î©w½d³ò
  8.     End With
  9.     With DataBase
  10.         .Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header:=xlYes
  11.         '2003 ±Æ§Ç¥u¦³3­Ó±Æ§ÇÄæ¦ì :¬P´Á,®Æ¸¹,³æ¦ì
  12.         .Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Key3:=.Cells(1, 6), Order3:=xlAscending, Header:=xlYes
  13.         '¦A¦¸±Æ§Ç:¬P´Á,®Æ¸¹,©m¦W
  14.         For I = 1 To .Rows.Count
  15.             With .Rows(I)
  16.                 W = .Cells(2) & .Cells(3) & .Cells(4) & .Cells(6) '¡u¬P´Á+®Æ¸¹+³æ¦ì+©m¦W¡v¥|Äæ¦ì¸ê®Æ
  17.             End With
  18.             If Not D.Exists(W) Then
  19.                 'Exists ¤èªk ¦pªG¦b Dictionary ª«¥ó¤¤«ü©wªºÃöÁä¦r¦s¦b¡A¶Ç¦^ True¡A­Y¤£¦s¦b¡A¶Ç¦^ False¡C
  20.                 '»yªk  Object.Exists (key)
  21.                 Set D(W) = .Rows(I)                 ''¦r¨åª«¥óªº¤º®e: ¬°Range
  22.             Else
  23.                 Set D(W) = Union(D(W), .Rows(I))    'Union ¤èªk ¶Ç¦^¨â­Ó©Î¦h­Ó½d³òªº¦X¨Ö½d³ò¡C
  24.             End If
  25.         Next
  26.         For Each D_Item In D.ITEMS                     '¨Ì§Ç¶Ç¦^ ¦r¨åª«¥óªº¤º®e
  27.             With D_Item                                '¦r¨åª«¥óªº¤º®e: ¬°Range
  28.                 If .Rows.Count > 1 Then                '
  29.                     For I = 2 To .Rows.Count           '±q²Ä2¦C¶}©l
  30.                         .Rows(I).Interior.Color = vbYellow
  31.                         .Rows(I).Cells(4) = 0
  32.                         .Rows(I).Cells(4).Font.Color = vbRed
  33.                     Next
  34.                 End If
  35.             End With
  36.         Next
  37.     End With
  38. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¡i¥Í©R¦b©I§l¶¡¡j¦òªû»¡¡G¡u¥Í©R¦b©I§l¶¡¡C¡v¤HµLªkºÞ¦í¦Û¤vªº¥Í©R¡A§óµLªk¾×¦í¦º´Á¡AÅý¦Û¤v¥Ã¦í¤H¶¡¡C¬JµM¥Í©R¥h¨Ó³o»òµL±`¡A§Ú­Ì§óÀ³¸Ó¦n¦n¦a·R±¤¥¦¡B§Q¥Î¥¦¡B¥R¹ê¥¦¡AÅý³oµL±`¡BÄ_¶Qªº¥Í©R¡A´²µo¥¦¯uµ½¬üªº¥ú½÷¡A¬M·Ó¥X¥Í©R¯u¥¿ªº»ù­È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD