|
Sub limonet()
Dim Cn As Object, StrSQL$, Arr As Variant, i%, j%, Brr As Variant, intNum%
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
Arr = Cn.Execute("Select 商品编码,采购日期,First(Replace(商品名称,' ','')) From [汇总表格$] Group By 商品编码,采购日期").GetRows
ReDim Preserve Arr(0 To 2, 0 To UBound(Arr, 2) + 1)
For i = UBound(Arr, 2) - 1 To 0 Step -1
If i = UBound(Arr, 2) - 1 Or Arr(0, i) <> Arr(0, i + 1) Then
Cn.Close: Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & ThisWorkbook.Path & "\" & Arr(0, i) & ".xlsx"
End If
StrSQL = "Select * Into [" & Arr(1, i) & "] From [Excel 12.0;DataBase=" & ThisWorkbook.FullName & "].[汇总表格$] Where 商品编码=" & Arr(0, i) & " And 采购日期=#" & Arr(1, i) & "#"
Cn.Execute (StrSQL): Brr = Cn.Execute(Replace(StrSQL, "Into [" & Arr(1, i) & "]", "")).GetRows(, , "版型")
intNum = FreeFile
Open ThisWorkbook.Path & "\" & Arr(2, i) & Arr(1, i) & ".txt" For Output As #intNum
For j = 0 To UBound(Brr, 2)
Write #intNum, Brr(0, j)
Next j
Close intNum
Next i
End Sub
|
|