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

­«½Æ­È¤À²Õ

¦^´_ 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 ²Õ§O from [" & .Name & "$A1:B] order by ²Õ§O"
ar = CN.Execute(q).getrows
.[F1].Resize(1, UBound(ar, 2) + 1) = ar
q = "select ½s¸¹ from [" & .Name & "$A1:A] group by ½s¸¹ "
.[E2].CopyFromRecordset CN.Execute(q & "having count(*) > 1 order by ½s¸¹")
.[E1] = "­«½Æ­È": w = 6
For Each Z In ar
o = "select b.²Õ§O from [" & .Name & "$E1:E] as a left join ( "
o = o & "select * from [" & .Name & "$A1:B] where ²Õ§O='" & Z & "') as b on a.­«½Æ­È = b.½s¸¹"
.Cells(2, w).CopyFromRecordset CN.Execute(o): w = w + 1
Next: End With
End Sub
123.zip (15.33 KB)

TOP

        ÀR«ä¦Û¦b : ¤£­n¤p¬Ý¦Û¤v¡A¦]¬°¤H¦³µL­­ªº¥i¯à¡C
ªð¦^¦Cªí ¤W¤@¥DÃD