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

2 回答

• 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/

  回复于 2024-04-19T06:05:16+08:00
• 0

  我猜你正在将数据从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
  

  回复于 2024-04-19T06:05:16+08:00