|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 iwangyi 于 2020-1-6 23:11 编辑
Sub C()
Set CN = CreateObject("ADODB.CONNECTION")
Set rs = CreateObject("ADODB.RECORDSET")
Set D = CreateObject("SCRIPTING.DICTIONARY")
With CN
.PROVIDER = "MICROSOFT.JET.OLEDB.4.0"
.CONNECTIONSTRING = "EXTENDED PROPERTIES=EXCEL 8.0;DATA SOURCE=" & ThisWorkbook.FullName
.Open
End With
Sql = "SELECT DISTINCT ID FROM [SHEET7$A1:B]"
rs.Open Sql, CN, 1, 3
N = rs.RecordCount
For I = 2 To N + 1
Cells(I, "D") = rs.Fields(0)
Sql = "SELECT 颜色 FROM [SHEET7$A1:B] WHERE ID='" & rs.Fields(0) & "'"
For Each K In CN.Execute(Sql).GETROWS
D(K) = ""
Next
Cells(I, "E") = Join(D.KEYS, ",")
D.RemoveAll
rs.movenext
Next
End Sub
|
|