- 帖子
- 354
- 主題
- 5
- 精華
- 0
- 積分
- 387
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-8-2
 
|
回復 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)
|
|