使用类似于QueryTable的东西导入Excel文件？

要将数据导入到excel文件中，当源文件是.csv文件时， QueryTable非常方便，例如，在Excel中使用QueryTables导入带有带引号的换行符的csv ，但是它不适用于Excel源文件。

导入excel文件可以通过VBA完成 ，只是想知道，如果有一些方便的QueryTable，从Excel文件导入，只需要指定源文件名，表名或范围名？

Answer 1

原来如此。 好吧，您可以使用VBA将工作表中的数据导入到工作簿中。

' Get customer workbook... Dim customerBook As Workbook Dim filter As String Dim caption As String Dim customerFilename As String Dim customerWorkbook As Workbook Dim targetWorkbook As Workbook ' make weak assumption that active workbook is the target Set targetWorkbook = Application.ActiveWorkbook ' get the customer workbook filter = "Text files (*.xlsx),*.xlsx" caption = "Please Select an input file " customerFilename = Application.GetOpenFilename(filter, , caption) Set customerWorkbook = Application.Workbooks.Open(customerFilename) ' assume range is A1 - C10 in sheet1 ' copy data from customer to target workbook Dim targetSheet As Worksheet Set targetSheet = targetWorkbook.Worksheets(1) Dim sourceSheet As Worksheet Set sourceSheet = customerWorkbook.Worksheets(1) targetSheet.Range("A1", "C10").Value = sourceSheet.Range("A1", "C10").Value ' Close customer workbook customerWorkbook.Close 

或者，您可以使用查询工具从另一个Excel文件导入数据。

http://dailydoseofexcel.com/archives/2004/12/13/parameters-in-excel-external-data-queries/

Answer 2

我猜你正在从Access导入数据到Excel。 我不认为你指定了你的来源，或者我无法做出来。 我的眼睛不如以前那么好

无论如何，考虑这个选项。

 Sub ADOImportFromAccessTable(DBFullName As String, _ TableName As String, TargetRange As Range) ' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _ "TableName", Range("C1") Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer Set TargetRange = TargetRange.Cells(1, 1) ' open the database Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _ DBFullName & ";" Set rs = New ADODB.Recordset With rs ' open the recordset .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable ' all records '.Open "SELECT * FROM " & TableName & _ " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText ' filter records RS2WS rs, TargetRange ' write data from the recordset to the worksheet ' ' optional approach for Excel 2000 or later (RS2WS is not necessary) ' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names ' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name ' Next ' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data End With rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub 

或这个。

 Sub RS2WS(rs As ADODB.Recordset, TargetCell As Range) Dim f As Integer, r As Long, c As Long If rs Is Nothing Then Exit Sub If rs.State <> adStateOpen Then Exit Sub If TargetCell Is Nothing Then Exit Sub With Application .Calculation = xlCalculationManual .ScreenUpdating = False .StatusBar = "Writing data from recordset..." End With With TargetCell.Cells(1, 1) r = .Row c = .Column End With With TargetCell.Parent .Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear ' clear existing contents ' write column headers For f = 0 To rs.Fields.Count - 1 On Error Resume Next .Cells(r, c + f).Formula = rs.Fields(f).Name On Error GoTo 0 Next f ' write records On Error Resume Next rs.MoveFirst On Error GoTo 0 Do While Not rs.EOF r = r + 1 For f = 0 To rs.Fields.Count - 1 On Error Resume Next .Cells(r, c + f).Formula = rs.Fields(f).Value On Error GoTo 0 Next f rs.MoveNext Loop .Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True .Columns("A:IV").AutoFit End With With Application .StatusBar = False .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub