Excel 尝试将CSV文件导入名为import的工作表

Excel 尝试将CSV文件导入名为import的工作表,excel,vba,csv,import,Excel,Vba,Csv,Import,下面是我的Txt文件的样子。。。这将通过一个旧但有用的工具导出: 以下是我在互联网上找到的代码: Option explicit Sub ReadInCommaDelimFile() 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

下面是我的Txt文件的样子。。。这将通过一个旧但有用的工具导出:

以下是我在互联网上找到的代码:

Option explicit

Sub ReadInCommaDelimFile()

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, *.TXT", , "Select File to Import")
If sCSV = "False" Then Exit Sub

'Clear Existing Data
ThisWorkbook.Worksheets("IMPORT").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 = Range("A2")
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
以下是我的结果:

不管我怎么做,我总是被引号和逗号卡住

以下是工作代码:

 Option Explicit

 Sub ReadInCommaDelimFile()
 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
 Dim sValue2 As String 'Individual comma delimited value



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

'Clear Existing Data
ThisWorkbook.Worksheets("IMPORT").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 = Range("A2")
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
            sValue2 = Left(sValue, Len(sValue) - 1)
            sValue2 = Right(sValue2, Len(sValue2) - 1)
            rCurrentCell = sValue2 '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

尝试在sValue=ParseDatasLine,,'上面添加此项以删除单引号

sLine = Replace(sLine, "'", "")

上一次代码迭代表明CSV文件保存为*.txt文件

如果确实是这样,您可以使用Workbooks.OpenText方法打开它,该方法允许您正确解析数据,包括处理singlequote文本限定符字符

这不会像QueryTables方法那样创建表

然后将新打开的工作簿中的数据复制到当前工作簿中的导入工作表中

例如:

Option Explicit
Sub ReadInCommaDelimFile()
    Dim sCSV
    Dim WB As Workbook, dataWS As Worksheet
sCSV = Application.GetOpenFilename("CSV Files (*.txt),*.txt", , "Select File to Import")
    If sCSV = False Then Exit Sub

ThisWorkbook.Worksheets("IMPORT").Cells.Clear

Application.ScreenUpdating = False
Workbooks.OpenText Filename:=sCSV, _
        textqualifier:=xlTextQualifierSingleQuote, _
        consecutivedelimiter:=True, _
        Tab:=False, _
        semicolon:=False, _
        comma:=True, _
        Space:=False, _
        other:=False

Set WB = ActiveWorkbook

Set dataWS = WB.Worksheets(1)

dataWS.UsedRange.Copy ThisWorkbook.Worksheets("IMPORT").Range("A2")

WB.Close savechanges:=False

End Sub

…一种解决方案是添加另一个条件循环,以删除引号,并在单个单元格中对起始数据进行通信,还是将类似“AAAA”的值分别放在各自的单元格中?如果全部在单个单元格中,则使用TextToColumns。如果在单独的单元格中,则执行替换以删除不需要的字符。您的ParseData函数正在重新发明现有的Excel功能。嗨,BigBen,问题是我无法使用查询表,因为一旦完成导入,我需要将数据转换成一个表,但QueryTable函数会创建一个我无法发布或修改的表taet。。。但它确实以正确的方式复制了数据!!它似乎来自ParseData finction。。。这是我现在得到的…'5555'所以之前和之后。。。如果我在ParseData之前查看值,则它们不在那里。