簡體   English   中英

使用VBA打開CSV文件

[英]Opening csv files using vba

CSV文件我在打開CSV文件時遇到了奇怪的問題。 我已經編寫了一個代碼來打開CSV文件,並使用vba在excel中對其進行處理。 我只能打開一個特定的CSV文件,但不能打開任何其他CSV文件,但是我無法在excel中打開它或對其進行處理,我不知道為什么。 為什么Excel VBA只讀取一個特定文件。 下面的代碼

Sub lithium()
Dim ws As Worksheet
Dim MyData As String, strData() As String
Dim PathInit As String
Dim i As Integer
Dim z As Long, filecount As Long
Dim l As Long
Dim LR As Long
k = 2
LR = Range("A" & Rows.Count).End(xlUp).Row

' Opening the txt file
Dim myTxt
myTxt = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=False)



Open myTxt For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf) ' Saving the entire value of the text file into the array. every element in the array in the entire row of the txt file

 Dim strRow1() As String
 Dim strRow2() As String
 Dim strRow3() As String
 Dim strRow4() As String
 Dim strRow5() As String
 Dim strRow6() As String
 Dim nCount As Integer


 nCount = 1
 Dim nRowLenth As Integer
 nRowLenth = UBound(strData) - LBound(strData) ' Length of the total data array
 j = 3

For i = 18 To nRowLenth


          strRow1() = Split(strData(i), ";")

           Cells(j, 15).value = strRow1(0)
           Cells(j, 16).value = strRow1(1)
           If Cells(j, 16).value = "c0" Then Cells(j, 17).value = strRow1(2)
           If Cells(j, 16).value = "c1" Then Cells(j, 18).value = strRow1(2)
           If Cells(j, 16).value = "c4" Then Cells(j, 19).value = strRow1(2)
           Cells(j, 21).value = Left(Cells(j, 17).value, 2)
           Cells(j, 22).value = Left(Cells(j, 18).value, 2)
           Cells(j, 23).value = Right(Left(Cells(j, 18).value, 6), 2) & Right(Left(Cells(j, 18).value, 4), 2)
           Cells(j, 23).NumberFormat = "0000"
           Cells(j, 24).value = Left(Cells(j, 19).value, 2)
           Cells(j, 26).value = Right(Left(Cells(j, 19).value, 12), 2) & Right(Left(Cells(j, 19).value, 10), 2)
           Cells(j, 27).value = Right(Left(Cells(j, 19).value, 16), 2) & Right(Left(Cells(j, 19).value, 14), 2)
           If Cells(j, 16).value = "c0" Then Cells(j, 1).value = Cells(j, 15).value Else _
           If Cells(j, 16).value = "c1" Then Cells(j, 1).value = Cells(j, 15).value Else _
           If Cells(j, 16).value = "c4" Then Cells(j, 1).value = Cells(j, 15).value Else _

           If Cells(j, 21).value = "" Then Cells(j, 2).value = "#N/A" Else Cells(j, 2).value = CLng("&H" & Cells(j, 21).value)
           If Cells(j, 22).value = "" Then Cells(j, 3).value = "#N/A" Else Cells(j, 3).value = CLng("&H" & Cells(j, 22).value)
           If Cells(j, 24).value = "" Then Cells(j, 4).value = "#N/A" Else Cells(j, 4).value = CLng("&H" & Cells(j, 24).value) - 40
        Cells(j, 5).value = CLng("&H" & Cells(j, 25).value) - 40
           If Cells(j, 23).value = "" Then Cells(j, 5).value = "#N/A" Else Cells(j, 5).value = CLng("&H" & Cells(j, 23).value) - 32768
           If Cells(j, 26).value = "" Then Cells(j, 6).value = "#N/A" Else Cells(j, 6).value = CLng("&H" & Cells(j, 26).value)
           If Cells(j, 27).value = "" Then Cells(j, 7).value = "#N/A" Else Cells(j, 7).value = CLng("&H" & Cells(j, 27).value)
           If Cells(j, 27).value = "" Then Cells(j, 8).value = "#N/A" Else Cells(j, 8).value = Cells(j, 6).value - Cells(j, 7).value


    j = j +1
    Next

    End Sub

而且對於該特定文件,它也可以正常工作,但是我得到了一個錯誤索引,該索引超出范圍,我不知道為什么。 如果有人可以幫助

也許您可以從這兩種解決方案之一中獲得一些想法。

' Merge data from multiple sheets into seperate sheets
Sub R_AnalysisMerger2()
    Dim WSA As Worksheet
    Dim bookList As Workbook
    Dim SelectedFiles As Variant
    Dim NFile As Long
    Dim FileName As String
    Dim Ws As Worksheet, vDB As Variant, rngT As Range
    Dim vFn, myFn As String

    Application.ScreenUpdating = False

    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True)
    If IsEmpty(SelectedFiles) Then Exit Sub

    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        FileName = SelectedFiles(NFile)
        vFn = Split(FileName, "\")
        myFn = vFn(UBound(vFn))
        myFn = Replace(myFn, ".csv", "")
        Set bookList = Workbooks.Open(FileName, Format:=2)
        Set WSA = bookList.Sheets(1)
        vDB = WSA.UsedRange
        bookList.Close (0)
        Set Ws = Sheets.Add(after:=Sheets(Sheets.Count))
        ActiveSheet.Name = myFn
        Ws.Range("a1").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next
    Application.ScreenUpdating = True

End Sub

' Merge data from multime files into one sheet.
Sub R_AnalysisMerger()
    Dim WSA As Worksheet
    Dim bookList As Workbook
    Dim SelectedFiles() As Variant
    Dim NFile As Long
    Dim FileName As String
    Dim Ws As Worksheet, vDB As Variant, rngT As Range

    Application.ScreenUpdating = False


    Set Ws = ThisWorkbook.Sheets(1)
    Ws.UsedRange.Clear
    'change folder path of excel files here
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True)


    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        FileName = SelectedFiles(NFile)
        Set bookList = Workbooks.Open(FileName, Format:=2)
        Set WSA = bookList.Sheets(1)
        With WSA
            vDB = .UsedRange
            Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
            If rngT.Row = 2 Then Set rngT = Ws.Range("a1")
            rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

            bookList.Close (0)
        End With
    Next
    Application.ScreenUpdating = True
    Ws.Range("A1").Select

End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM