返回列表 上一主題 發帖

重複值分組

回復 1# eric7765


    Sub test()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then C = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then C = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open C & "Data Source=" & ThisWorkbook.FullName:
With ActiveSheet: .Range("E:Z").ClearContents
q = "select distinct 組別 from [" & .Name & "$A1:B] order by 組別"
ar = CN.Execute(q).getrows
.[F1].Resize(1, UBound(ar, 2) + 1) = ar
q = "select 編號 from [" & .Name & "$A1:A] group by 編號 "
.[E2].CopyFromRecordset CN.Execute(q & "having count(*) > 1 order by 編號")
.[E1] = "重複值": w = 6
For Each Z In ar
o = "select b.組別 from [" & .Name & "$E1:E] as a left join ( "
o = o & "select * from [" & .Name & "$A1:B] where 組別='" & Z & "') as b on a.重複值 = b.編號"
.Cells(2, w).CopyFromRecordset CN.Execute(o): w = w + 1
Next: End With
End Sub
123.zip (15.33 KB)

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題