导入逗号分隔到特定工作表

时间:2016-01-16 16:51:12

标签: excel vba import

我正在尝试将逗号分隔的文本文件导入到工作簿中的特定工作表中。我已导入的代码,但我无法弄清楚如何告诉它去了已经创建的特定工作表,因为现在它只是创建一个新工作表并将数据转储到那里。

我的代码是

'Import Report

      Dim vPath As Variant
      Dim wb As Excel.Workbook
      Dim ws As Excel.Worksheet

      Set wb = Excel.ActiveWorkbook
      Set ws = Excel.Sheets("Data")
      vPath = Application.GetOpenFilename("CSV (Comma Delimited) (*.csv),*.csv" _
      , 1, "Select a file", , False)

      ''//Show the file open dialog to allow user to select a CSV file

      If vPath = False Then Exit Sub

      ''//Exit macro if no file selected

      Workbooks.OpenText Filename:=vPath, Origin:=xlMSDOS, StartRow:=1 _
      , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True _
      , FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), _
      Array(3, xlTextFormat))

      ''//The fieldinfo array needs to be extended to match your number of columns

      Columns.EntireColumn.AutoFit

      ''//Resize the columns

      Sheets(1).Move Before:=wb.Sheets(1)

      ''//Move the data into the Workbook

我想我只需要添加类似的内容;

Destination:=Range("Sheet2!$A$1")
在某个地方,但我无法弄清楚在哪里,我尝试过的地方都会造成错误

2 个答案:

答案 0 :(得分:3)

这是一个开始:

Sub CSV_Reader()
      Dim vPath As Variant
      Dim wb As Excel.Workbook
      Dim ws As Excel.Worksheet
      Dim rng As Range, TextLine As String
      Dim rw As Long, col As Long
      Dim i As Long, j As Long, ary() As String, a As Variant

      Set wb = Excel.ActiveWorkbook

      vPath = Application.GetOpenFilename("CSV (Comma Delimited) (*.csv),*.csv" _
         , 1, "Select a file", , False)
      MsgBox vPath
      Set rng = Application.InputBox(Prompt:="Pick a Sheet and a Cell", Type:=8)
      rng.Parent.Parent.Activate
      rng.Parent.Activate
      rw = rng(1).Row
      col = rng(1).Column

      Close #1
      i = rw
      Open vPath For Input As #1
      Do While Not EOF(1)
         Line Input #1, TextLine
         ary = Split(TextLine, ",")
         j = col
         For Each a In ary
            Cells(i, j).Value = a
            j = j + 1
         Next a
         i = i + 1
      Loop
      Close 1

End Sub

答案 1 :(得分:0)

这是我发现作品的另一种方式,(以防万一其他人有这个问题,他们可以找到它)没有用户互动(所以他们不能弄乱它)

Sub Import()
Dim rFirstCell As Range 'Points to the First Cell in the row currently being     updated
Dim rCurrentCell As Range 'Points the the current cell in the row being updated
Dim sCSV As String 'File Name to Import
Dim iFileNo As Integer 'File Number for Text File operations
Dim sLine As String 'Variable to read a line of file into
Dim sValue As String 'Individual comma delimited value

'Prompt User for File to Import
sCSV = Application.GetOpenFilename("CSV Files, *.CSV", , "Select File to Import")
If sCSV = "False" Then Exit Sub

'Clear Existing Data
ThisWorkbook.Worksheets("Data").Cells.Delete
'wsData.Cells.Delete 'Use this method if you set the vb-name of the sheet

'Set initial values for Range Pointers
Set rFirstCell = Sheets("Data").Range("A1")
Set rCurrentCell = rFirstCell

'Get an available file number
iFileNo = FreeFile

'Open your CSV file as a text file
Open sCSV For Input As #iFileNo

'Loop until reaching the end of the text file
Do Until EOF(iFileNo)

    'Read in a line of text from the CSV file
    Line Input #iFileNo, sLine

    Do
        sValue = ParseData(sLine, ",")

        If sValue <> "" Then
            rCurrentCell = sValue 'put value into cell
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
        End If

    Loop Until sValue = ""

    Set rFirstCell = rFirstCell.Offset(1, 0) 'move pointer down one row
    Set rCurrentCell = rFirstCell 'set output pointer to next line
Loop

'Close the Text File
Close #iFileNo

End Sub

Private Function ParseData(sData As String, sDelim As String) As String
Dim iBreak As Integer

iBreak = InStr(1, sData, sDelim, vbTextCompare)

If iBreak = 0 Then
    If sData = "" Then
        ParseData = ""
    Else
        ParseData = sData
        sData = ""
    End If
Else
    ParseData = Left(sData, iBreak - 1)
    sData = Mid(sData, iBreak + 1)
End If

End Function