[英]Copy/paste cells based on header value
下面介紹如何使用 ADODB。
Sub Test()
Dim Ws As Worksheet
Dim sql As String
Dim vFild()
Dim rngFild As Range, rng As Range
Dim strFild As String
Dim n As Integer
Set Ws = Sheets("Output")
With Ws
Set rngFild = .Range("a1", .Range("a1").End(xlToRight))
End With
For Each rng In rngFild
n = n + 1
ReDim Preserve vFild(1 To n)
vFild(n) = "[" & rng & "]"
Next rng
strFild = Join(vFild, ",")
sql = "select " & strFild & "from [Input$] "
exeSQL Ws, sql
End Sub
Sub exeSQL(Ws As Worksheet, strSQL As String)
Dim Rs As Object
Dim strConn As String
Dim i As Integer
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 12.0;"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
.Range("a1").CurrentRegion.Offset(1).ClearContents
'For i = 0 To Rs.Fields.Count - 1
' .Cells(1, i + 1).Value = Rs.Fields(i).Name
'Next
.Range("a" & 2).CopyFromRecordset Rs
End With
End If
Rs.Close
Set Rs = Nothing
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.