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

[µo°Ý] Ãö©ó·s¼W¸ê®Æªº¤ñ¹ï

[µo°Ý] Ãö©ó·s¼W¸ê®Æªº¤ñ¹ï

¦U¦ì«e½ú¦n

¤p©f¬OVBAªºªì¾ÇªÌ¡A¥Ø«e¹J¨ì¤@­Ó²~ÀV:L  (¦³¦bºô¸ô¤Wª¦¹L¤å¡A¦ý§ä¤£¨ìÃþ¦ü¥\¯àªº¼gªk)
"¸ê®Æ"ªº¤u§@ªí ·Q­n¥h¸ò ²{¦³"List"¤u§@ªí°µ¤ñ¹ï¡A¤ñ¹ï«á"¸ê®Æ"­Y¦³·s¼Wªº¡A«h¶K¨ì"¦¹¦¸·s¼Wªº"¤u§@ªí¸Ì­±
½Ð°Ý¦³­þ¤@¦ì«e½ú¥i¥H«üÂI¤@¤Uµ{¦¡½X¦p¦ó¼¶¼g¶Ü?


«D±`ÁÂÁÂ!!


·s¼W¸ê®Æ.rar (6.4 KB)

¤£¦n·N«ä~
§Ú­è·Q»¡¤¤¤åºô­¶§ä¤£¨ìÃþ¦üªº¥\¯à(¦³¥i¯à§Ú¦Û¤vÃöÁä¦r¤U¿ù^^")
©Ò¥H§Ú¨ì°ê¥~§äÃþ¦ü¥\¯à¡Aµo²{¤@¦ì JLGWhiz ªº¦^¤å¹ï§ÚªººÃ°Ý¦³À°§U
§Úµy·L§ï¼g¤F¤@¤Uµ{¦¡½X
¦ýÁÙ¬OµLªk²Å¦X§Ú¹w´Áªº
¶]¥X¨Óªºµ²ªG¬O³o¼Ë
°ÝÃD.JPG
§Ú»Ý­nªº¬O³o¼Ë
[attach]24551[/attach]

½Ð°Ý¦³½Ö¯àÀ°¦£­×§ï¤@¤Uµ{¦¡½X¶Ü?(§xÂZ§Ú¦n¤[ªº°ÝÃDQQ...)

«D±`·PÁÂ:L

·s¼W¸ê®Æ.rar (12.96 KB)

TOP

¦^´_ 2# Michelle-W

¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim d As Object, d_New As Object, i As Double, s   As String, k As Variant
  4.     Set d = CreateObject("scripting.dictionary")          ' ¦r¨åª«¥ó : List¸ê®Æ
  5.     Set d_New = CreateObject("scripting.dictionary") ' ¦r¨åª«¥ó : ¤ñ¹ï¥X List ©Ò¨S¦³ªº¸ê®Æ
  6.     With Sheets("List").UsedRange
  7.         For i = 2 To .Rows.Count
  8.             s = Join(Application.Transpose(Application.Transpose(.Rows(i).Value)), ",")
  9.             d(s) = .Rows(i)
  10.         Next
  11.     End With
  12.     With Sheets("¸ê®Æ").UsedRange
  13.         For i = 1 To .Rows.Count
  14.             s = Join(Application.Transpose(Application.Transpose(.Rows(i).Value)), ",")
  15.             If d.EXiSTS(s) = False Then d_New(s) = .Rows(i)
  16.         Next
  17.     End With
  18.     With Sheets("¦¹¦¸·s¼W").UsedRange
  19.         .Clear
  20.         If d_New.Count > 1 Then
  21.             i = 1
  22.             For Each k In d_New.KEYS
  23.                 .Cells(i, "A").Resize(, 3) = d_New(k)
  24.                 i = i + 1
  25.             Next
  26.         Else
  27.             MsgBox "¦¹¦¸·s¼W ¨S¦³ ·s¼W¸ê®Æ !"
  28.         End If
  29.     End With
  30. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# GBKEE

«D±`ÁÂÁª©¥D!! ¥i¥H¹B§@¤F~^^
¥t¥~·Q½Ð±Ðª©¥D¤@¤U
¦pªG¨C­Ósheet ²Ä¤@¦Cª½±µ¬O¸ê®Æ(¨S¦³©m¦W¡B¦~ÄÖ¡B±B«Ã)
½Ð°Ýµ{¦¡½X­n«ç»ò·L½Õ? ²Ä¤@¦Cªº¸ê®Æ³£·|¤@°_±a¤J¦¹¦¸·s¼Wªº¤u§@ªí¸Ì­±QQ"

TOP

¦^´_ 4# Michelle-W
  1. With Sheets("List").UsedRange
  2.        For i = 2 To .Rows.Count
½Æ»s¥N½X
¨º´N±q²Ä¤@¦C¶}©l
  1. With Sheets("List").UsedRange
  2.        For i = 1 To .Rows.Count
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# Michelle-W
¨ä¹ê§A­ì¥»¤§µ{¦¡½Xµy¥[½Õ¾ã¡A
¤]¬O¥i¦æªº¡G
  1. Sub ¤ñ¹ï·s¼W()
  2.     Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
  3.     Dim rng1 As Range, rng2 As Range, c As Variant, cts As Variant, ct2 As Variant
  4.    
  5.     Set sh1 = Sheets(1)        '  ¸ê®Æ
  6.     Set sh2 = Sheets(2)        '  List
  7.     Set sh3 = Sheets(3)        '  ¦¹¦¸·s¼W
  8.    
  9.     lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row    '  ¸ê®Æ
  10.     lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row    '  List
  11.    
  12.     Set rng1 = sh1.Range("A1:A" & lr1)        '  ¸ê®Æ
  13.     Set rng2 = sh2.Range("A1:A" & lr2)        '  List
  14.    
  15.     With sh3                                  '  ¦¹¦¸·s¼W
  16.         .Cells.Clear

  17.         '  .Range("A1") = "©m¦W"
  18.         '  .Range("B1") = "¦~ÄÖ"
  19.         '  .Range("C1") = "±B«Ã"
  20.         .Range("A1").Resize(, 3) = Split("©m¦W,¦~ÄÖ,±B«Ã", ",")
  21.     End With
  22.    
  23.     For Each c In rng1                                          '  ¸ê®Æ
  24.         Set cts = rng1.Find(c.Value, , LookIn:=xlValues)
  25.         Set ct2 = rng2.Find(c.Value, , LookIn:=xlValues)
  26.         '  If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  27.         If Not cts Is Nothing And ct2 Is Nothing Then                                          '  List
  28.             sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(cts.Row).Value    '  ¦¹¦¸·s¼W
  29.         End If
  30.     Next
  31. End Sub
½Æ»s¥N½X
GBKEE ª©¤j¨º¨à¡A§A¤]¥i¥H¾Ç¨ì¤£¿ùªºÆ[©À»P§Þ¥©¡C

TOP

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2016-6-27 06:13 ½s¿è

¦^´_ 4# Michelle-W
¤ñ¹ï·s¼W¸ê®Æ.rar (23.51 KB)
ªþ¤WÀɮרѧA´ú¸Õ¡C
¤ñ¹ï·s¼W¸ê®Æ(xls ®æ¦¡).rar (13.85 KB)
¦pªG§A¨ÌµM·Q¥Î­ì¥»¤§«Å§i
  1. If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  2.        .
  3.        .
  4. End If
½Æ»s¥N½X
¥ç¥i¡A ¨ä»P¼Ó¤W (#6) ªº
  1. If Not cts Is Nothing And ct2 Is Nothing Then
  2.        .
  3.        .
  4. End If
½Æ»s¥N½X
ªí­z¬O²§¦±¦P¤u¡C(¬Ù²¤¤F ct2 ªºÅܼƫŧi»Pµ¹¤©­È (Assign Value) ªº³]©w )
  1. Sub ¤ñ¹ï·s¼W2()
  2.     Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
  3.     Dim rng1 As Range, rng2 As Range, c As Variant, cts As Variant
  4.    
  5.     Set sh1 = Sheets(1)        '  ¸ê®Æ
  6.     Set sh2 = Sheets(2)        '  List
  7.     Set sh3 = Sheets(3)        '  ¦¹¦¸·s¼W
  8.    
  9.     lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row    '  ¸ê®Æ
  10.     lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row    '  List
  11.    
  12.     Set rng1 = sh1.Range("A1:A" & lr1)        '  ¸ê®Æ
  13.     Set rng2 = sh2.Range("A1:A" & lr2)        '  List
  14.    
  15.     With sh3                                  '  ¦¹¦¸·s¼W
  16.         .Cells.Clear

  17.         '  .Range("A1") = "©m¦W"
  18.         '  .Range("B1") = "¦~ÄÖ"
  19.         '  .Range("C1") = "±B«Ã"
  20.         .Range("A1").Resize(, 3) = Split("©m¦W,¦~ÄÖ,±B«Ã", ",")
  21.     End With
  22.    
  23.     For Each c In rng1                                          '  ¸ê®Æ
  24.         Set cts = rng1.Find(c.Value, , LookIn:=xlValues)
  25.         
  26.         If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  27.             sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(cts.Row).Value    '  ¦¹¦¸·s¼W
  28.         End If
  29.     Next
  30. End Sub
½Æ»s¥N½X
§í©Î¬O®Ú¥»¤£¨Ï¥Î  cts¡Bct2 ªº¨â­ÓÅܼƫŧi»Pµ¹¤©­È (Assign Value) ªº³]©w
  1. Sub ¤ñ¹ï·s¼W3()
  2.     Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
  3.     Dim rng1 As Range, rng2 As Range, c As Variant
  4.    
  5.     Set sh1 = Sheets(1)        '  ¸ê®Æ
  6.     Set sh2 = Sheets(2)        '  List
  7.     Set sh3 = Sheets(3)        '  ¦¹¦¸·s¼W
  8.    
  9.     lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row    '  ¸ê®Æ
  10.     lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row    '  List
  11.    
  12.     Set rng1 = sh1.Range("A1:A" & lr1)        '  ¸ê®Æ
  13.     Set rng2 = sh2.Range("A1:A" & lr2)        '  List
  14.    
  15.     With sh3                                  '  ¦¹¦¸·s¼W
  16.         .Cells.Clear

  17.         '  .Range("A1") = "©m¦W"
  18.         '  .Range("B1") = "¦~ÄÖ"
  19.         '  .Range("C1") = "±B«Ã"
  20.         .Range("A1").Resize(, 3) = Split("©m¦W,¦~ÄÖ,±B«Ã", ",")
  21.     End With
  22.    
  23.     For Each c In rng1                                          '  ¸ê®Æ
  24.         If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  25.             sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(c.Row).Value    '  ¦¹¦¸·s¼W
  26.         End If
  27.     Next
  28. End Sub
½Æ»s¥N½X
¨äµ²ªG¤´¬O¤@­Pªº¡C
¦¹ºÝµø§A­Ó¤H¼¶¼gªº¸gÅç¡B²ßºD»PÅÞ¿è«ä¦Ò¡C
¤ñ¹ï·s¼W¸ê®Æ(¦^Âk­ì©l).rar (16.91 KB)

TOP

¦^´_ 7# c_c_lai


±z­×§ïªºµ{¦¡½X³£¥i¥H¥Î
¦]¬°§Ú¬O¦Û¾Çªºªì¾ÇªÌ¡AÁ٬ݤ£À´¤Ó¦h
¤£¹L§ÚÁÙ¬O·|§V¤O·dÀ´ªº

¯uªº«D±`ÁÂÁ±z­Ì¨â¦ìªº±Ð¾É!~~^^

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-25 16:32 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

List¸ê®Æ®w:


¸ê®Æªí(·s¤ñ¹ï¸ê®Æ):


µ²ªGªí°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, T$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([List!C1], [List!A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HListªíA~CÄæÀx¦s®æ­È±a¤J°}¦C¸Ì
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3): Y(T) = i
   '¡ô¥O¥H¨C­Ó°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê·íkey,item¬O¦C¸¹,¯Ç¤JY¦r¨å
Next
Brr = Range([¸ê®Æ!C1], [¸ê®Æ!A65536].End(xlUp))
'¡ô¥OBr°}¦C,´«¸Ë¸ê®ÆªíA~CÄæÀx¦s®æ­È
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3)
   If Y(T) <> "" Then GoTo i01
   '¡ô¦pªG¥H°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê¬dY¦r¨å±oitem­È¤£¬OªÅªº,
   '´N¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ

   R = R + 1
   '¡ô¥ORÅܼƲ֥[1
   For j = 1 To 3: Brr(R, j) = Brr(i, j): Next
   '¡ô³]¶¶°j°é!±NBrr°}¦C­È©¹¤WÁÃ,±N­ì°}¦C­ÈÂл\
i01: Next
If R = 0 Then MsgBox "µL·s¼W": GoTo i02
'¡ô¦pªGRÅܼƬOªì©l­È0,´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
With Sheets("¦¹¦¸·s¼W")
   .UsedRange.Offset(1, 0).Clear
   '¡ô±Nµ²ªGªí¦³¨Ï¥ÎÀx¦s®æ©¹¤U°¾²¾1¦Cªº½d³ò²M°£
   .[A2].Resize(R, 3) = Brr
   '¡ô¥OBrr°}¦C­È¼g¤Jµ²ªGªí¤¤,¶W¥X½d³òªº°}¦C­È©¿²¤
End With
i02: Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub

=============================================
¸É¥R: ¥H¤U¬O±Nµ²ªG¸ê®ÆÁäJ¥t¤@°}¦Cªº¤èªk

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, R&, i&, j&, T$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([List!C1], [List!A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HListªíA~CÄæÀx¦s®æ­È±a¤J°}¦C¸Ì
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3): Y(T) = i
   '¡ô¥O¥H¨C­Ó°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê·íkey,item¬O¦C¸¹,¯Ç¤JY¦r¨å
Next
Brr = Range([¸ê®Æ!C1], [¸ê®Æ!A65536].End(xlUp))
'¡ô¥OBr°}¦C,´«¸Ë¸ê®ÆªíA~CÄæÀx¦s®æ­È
ReDim Crr(1 To UBound(Brr), 1 To 3)
'¡ô«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr,¾î¦V1~3
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3)
   If Y(T) <> "" Then GoTo i01
   '¡ô¦pªG¥H°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê¬dY¦r¨å±oitem­È¤£¬OªÅªº,
   '´N¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ

   R = R + 1
   '¡ô¥ORÅܼƲ֥[1
   For j = 1 To 3: Crr(R, j) = Brr(i, j): Next
   '¡ô³]¶¶°j°é!±NBrr°}¦C­È¼g¤JCrr°}¦C¤¤
i01: Next
If R = 0 Then MsgBox "µL·s¼W": GoTo i02
'¡ô¦pªGRÅܼƬOªì©l­È0,´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
With Sheets("¦¹¦¸·s¼W")
   .UsedRange.Offset(1, 0).Clear
   '¡ô±Nµ²ªGªí¦³¨Ï¥ÎÀx¦s®æ©¹¤U°¾²¾1¦Cªº½d³ò²M°£
   .[A2].Resize(R, 3) = Crr
   '¡ô¥OCrr°}¦C­È¼g¤Jµ²ªGªí¤¤,¶W¥X½d³òªº°}¦C­È©¿²¤
End With
i02: Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤ß¤¤±`¦sµ½¸Ñ¡B¥]®e¡B·P«ä¡Bª¾¨¬¡B±¤ºÖ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD