henry860608

¦n³á ·PÁ¤j¤j¼ö±¡¤À¨É ±ßÂI´N¨Ó¸Õ¸Õ¬Ý

singo1232001

¦^´_ 3# hcm19522


Sub ¥h­«±Æ§Ç()
With CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; "
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; "
.Open V & "Data Source=" & ThisWorkbook.FullName

Set s = Sheets("¤u§@ªí1")
s.Columns(4).ClearContents
s.Rows("1:1").Insert Shift:=xlDown
s.Range("a1:b1") = Array("a", "b")
q = "select a as a from [¤u§@ªí1$A1:A] " & vbCrLf & " union all "
q = q & vbCrLf & " select b as a from [¤u§@ªí1$B1:B]"
q = "select distinct a from (" & q & ")  order by a "
s.Range("d2").CopyFromRecordset .Execute(q)
s.Rows("1:1").Delete: End With
End Sub

hcm19522

https://blog.xuite.net/hcm19522/twblog/590762370

Andy2483

[attach]35988[/attach]¦^´_ 1# henry860608


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P±¡¹Ò
«á¾Ç½m²ß°}¦C»P¦r¨åªº¸Ñ¨M¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æ«e:

¤U¸ü (42.12 KB)

2023-3-20 11:57

°õ¦æµ²ªG:

¤U¸ü (45.4 KB)

2023-3-20 12:01

Option Explicit
Sub TEST()
Dim Brr, Y, C%, R&
'¡ô«Å§iÅܼÆ:(Brr,Y)¬O³q¥Î«¬ÅܼÆ,C¬Oµu¾ã¼Æ,R¬Oªø¾ã¼Æ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
[C:C].ClearContents
'¡ô¥OCÄæÀx¦s®æ¤º®e²M°£
Brr = Range([B1], Cells(Rows.Count, "A").End(3))
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,
'¥H[B1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ­È±a¤J
For C = 1 To 2
'¡ô³]¶¶°j°é!C±q1¨ì 2
   For R = 1 To UBound(Brr)
   '¡ô³]¶¶°j°é!R±q1¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
      Y(Brr(R, C)) = ""
      '¡ô¥OR°j°é¦CR°j°éÄæBrr°}¦C­È·íkey,item¬OªÅ¦r¤¸,¯Ç¤JY¦r¨å¸Ì
      '­Ykey­«½Æ¥u¯d¤@µ§
   Next
Next
With [C1].Resize(Y.Count, 1)
'¡ô¥H¤U¬OÃö©ó[C1]Àx¦s®æÂX®i¦V¤U(Y¦r¨åkey¼Æ¶q)¦Cªº¬ÛÃöµ{§Ç
   .Value = Application.Transpose(Y.Keys)
   '¡ô¥OÀx¦s®æ­È¥H Y¦r¨åkeyÂà¸m«á­È±a¤J
   .Sort KEY1:=.Item(1), Order1:=1, _
   Header:=0, Orientation:=1
   '¡ô¥O¥H[C1]§@¬°±Æ§Ç°ò·Ç°µ¤@¼h¦¸µL¼ÐÃD¦CªºÁa¦V¶¶±Æ§Ç
End With
Erase Brr: Set Y = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub