Option Explicit
Sub TEST()
Dim Brr, Y, C%, R&
'↑宣告變數:(Brr,Y)是通用型變數,C是短整數,R是長整數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
[C:C].ClearContents
'↑令C欄儲存格內容清除
Brr = Range([B1], Cells(Rows.Count, "A").End(3))
'↑令Brr這通用型變數是 二維陣列,
'以[B1]到A欄最後有內容儲存格值帶入
For C = 1 To 2
'↑設順迴圈!C從1到 2
For R = 1 To UBound(Brr)
'↑設順迴圈!R從1到 Brr陣列縱向最大索引列號
Y(Brr(R, C)) = ""
'↑令R迴圈列R迴圈欄Brr陣列值當key,item是空字元,納入Y字典裡
'若key重複只留一筆
Next
Next
With [C1].Resize(Y.Count, 1)
'↑以下是關於[C1]儲存格擴展向下(Y字典key數量)列的相關程序
.Value = Application.Transpose(Y.Keys)
'↑令儲存格值以 Y字典key轉置後值帶入
.Sort KEY1:=.Item(1), Order1:=1, _
Header:=0, Orientation:=1
'↑令以[C1]作為排序基準做一層次無標題列的縱向順排序
End With
Erase Brr: Set Y = Nothing
'↑令釋放變數
End Sub作者: hcm19522 時間: 2023-3-20 13:43
Sub 去重排序()
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("工作表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 [工作表1$A1:A] " & vbCrLf & " union all "
q = q & vbCrLf & " select b as a from [工作表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作者: henry860608 時間: 2023-3-20 23:01
Sub test()
Dim arr As Object, brr As Variant
Set arr = CreateObject("System.Collections.ArrayList")
brr = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each n In brr
If n <> vbNullString And Not arr.contains(n) Then arr.Add (n)
Next
arr.Sort
Range("c1:c" & arr.Count) = Application.Transpose(arr.toarray)
End Sub作者: henry860608 時間: 2023-3-21 11:35
select distinct a from
(select a as a from [工作表1$A1:A]
union all
select b as a from [工作表1$B1:B] )
order by a
1.
獲取工作表1中的A欄資料
select a as a from [工作表1$A1:A]
合併
union all
工作表1中的B欄資料
select b as a from [工作表1$B1:B]
2.
select distinct a from '將1.部分獲取整理好的資料 distinct去重
(select a as a from [工作表1$A1:A]
union all
select b as a from [工作表1$B1:B] )
order by a '並且order by排序
