|
Sub C()
UsedRange.Offset(1).ClearContents
Set CN = CreateObject("ADODB.CONNECTION")
Set RS = CreateObject("ADODB.RECORDSET")
Set D = CreateObject("SCRIPTING.DICTIONARY")
CN.Open "PROVIDER = MICROSOFT.JET.OLEDB.4.0;EXTENDED PROPERTIES=EXCEL 8.0;DATA SOURCE=" & ThisWorkbook.FullName
Sql = "SELECT DISTINCT 行标签 FROM [汇总$]"
RS.Open Sql, CN, 1, 3
N = RS.RecordCount
For i = 1 To N
Sql = "SELECT DISTINCT 商品名称 FROM (SELECT * FROM [汇总$] WHERE 行标签='" & RS.Fields(0) & "')"
ARR = CN.Execute(Sql).GETROWS
For Each K In ARR
If K <> "" Then
D(K) = ""
End If
Next
M = [A65536].End(3).Row + 1
Cells(M, 1) = RS.Fields(0).Value
Cells(M, 2) = Join(D.KEYS, "/")
D.RemoveAll
Sql = "SELECT DISTINCT 仓库 FROM (SELECT * FROM [汇总$] WHERE 行标签='" & RS.Fields(0) & "')"
BRR = CN.Execute(Sql).GETROWS
For Each KK In BRR
D(KK) = ""
Next
Cells(M, 3) = Join(D.KEYS, "/")
D.RemoveAll
RS.movenext
Next
End Sub
|
|