- ©«¤l
- 354
- ¥DÃD
- 5
- ºëµØ
- 0
- ¿n¤À
- 387
- ÂI¦W
- 0
- §@·~¨t²Î
- windows7
- ³nÅ骩¥»
- vba,vb,excel2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2017-1-8
- ³Ì«áµn¿ý
- 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 ²Õ§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)
|
|