- 帖子
- 192
- 主題
- 15
- 精華
- 0
- 積分
- 194
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- office2010
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2016-9-22
- 最後登錄
- 2020-8-28
 
|
6#
發表於 2017-1-21 12:07
| 只看該作者
回復 1# rouber590324 - Sub test()
- Dim sql$, pn$
- Sheet2.Cells.ClearContents
- Sheet2.Range("b:b").NumberFormatLocal = "yyyy/m/d h:mm;@"
- pn = ThisWorkbook.FullName
- sql = "select 品名,last(時間) as 時間,last(內容) as 內容 from [sheet1$] where 品名<>null group by 品名"
- SqCopy pn, sql, Sheet2.[a2], Sheet2.[a1]
- End Sub
- Sub SqCopy(pt As String, sq As String, Optional Rg As Range, Optional rg1 As Range)
- Dim conn As Object, rst As Object, i%
- Set conn = CreateObject("adodb.connection")
- Set rst = CreateObject("ADODB.recordset")
- Select Case Application.Version * 1
- Case Is <= 11
- conn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties='excel 8.0;hdr=yes;imex=1';data source=" & pt
- Case Is >= 12
- conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=yes;imex=1';data source=" & pt
- End Select
- Set rst = conn.Execute(sq)
- If Not rg1 Is Nothing Then
- For Each Field In rst.Fields
- rg1.Offset(0, i) = Field.Name
- i = i + 1
- Next
- End If
- If Not Rg Is Nothing Then
- Rg.CopyFromRecordset rst
- End If
- conn.Close
- Set rst = Nothing
- Set conn = Nothing
- End Sub
|
|
發表於 2017-1-20 10:11
| 
