返回列表 上一主題 發帖

[發問] 如何在不打開檔案下,將XML檔或CSV檔匯入EXCEL中

方法1: csv 格式很簡單, 自己寫個解析器,  很容易就可以匯入 ( 不然 google 應該可以找得到現成的 )
方法2:
用 Open CSV_FileName For Input As #1 把 csv大檔 切割成小於 65536 列的 數個小 csv 檔
再把這些小 csv 逐一匯入到 sheet1, sheet2 ....

TOP

本帖最後由 jackyq 於 2018-1-9 09:32 編輯

回復 3# paul3063


Private Function Get_CSVFile_Object(ByVal File_FullPathName As String) As Object
      Set rs = CreateObject("ADODB.Recordset")
    Set conn = CreateObject("ADODB.Connection")
   
    strFileName = CreateObject("Scripting.FileSystemObject").GetFileName(File_FullPathName)
    strFilePath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(File_FullPathName)
    aa = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source=" & strFilePath & ";" & _
         "Extended Properties='text;HDR=Yes;FMT=Delimited(,);CharacterSet=65001'"
    conn.Open aa, "", ""

    rs.Open "select * from [" & strFileName & "]", conn, adOpenStatic, adLockReadOnly, adCmdText
    Set Get_CSVFile_Object = rs
End Function

Private Sub GO______()
   
    Dim rsData As Object

    Csv = "C:\我的資料檔.csv"   ' 自己改成檔案真實路徑

    Set rsData = Get_CSVFile_Object(Csv)
   
    If rsData.RecordCount > 0 Then

        ReDim col(0 To rsData.Fields.Count)
        For w = 0 To rsData.Fields.Count - 1
            col(w) = rsData.Fields(w).Name
        Next   
        MsgBox Join(col, vbCrLf)
   
        rsData.MoveFirst
        Do While Not rsData.EOF
            For w = 0 To rsData.Fields.Count - 1
                col(w) = rsData.Fields(w).Value
                If IsNull(col(w)) Then col(w) = ""
            Next
            MsgBox Join(col, vbCrLf)
            Stop
            rsData.MoveNext
        Loop
    End If
    rsData.Close
End Sub

TOP

回復 3# paul3063

把資料分派到 sheet1 , sheet2 ..

勞煩大大自己處裡

TOP

回復 6# paul3063

放 module 好了
不過要把 private 字樣 改成 public
不然會呼叫不到

TOP

還真是慢呀

剛有試過一個方法
可以把倒進 sheet 的耗時降到 1/6
不過原碼沒有提供 倒進多sheet

TOP

本帖最後由 jackyq 於 2018-1-17 19:58 編輯

Public Sub 扁我______()
   
    Dim rsData As Object

    Csv = "C:\Documents and Settings\Administrator\My Documents\Downloads\36_2.csv\36_2.csv"   ' 自己改成檔案真實路徑

    Set rsData = Get_CSVFile_Object(Csv)
   
   
    每頁承載筆數 = 10000
    page_count = (rsData.RecordCount \ 每頁承載筆數) + Sgn(rsData.RecordCount Mod 每頁承載筆數)
   
    For w = 1 To page_count
        On Error Resume Next
        s = Sheets("Data_" & w).Name
        If Err Then
           Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Data_" & w
        End If
        On Error GoTo 0
        Sheets("Data_" & w).Cells.Clear
    Next
    Excel.Application.DisplayAlerts = 0
    On Error Resume Next
    For w = page_count + 1 To 10 ^ 9
        Sheets("Data_" & w).Delete
        If Err Then Exit For
    Next
    On Error GoTo 0
    Excel.Application.DisplayAlerts = 1

    If rsData.RecordCount > 0 Then
        ReDim 標題(0 To rsData.Fields.Count) As String
        For w = 0 To rsData.Fields.Count - 1
            標題(w) = rsData.Fields(w).Name
        Next

        For page = 1 To page_count
            Sheets("Data_" & page).Select
            Sheets("Data_" & page).Cells(1, 1).Resize(, UBound(標題) - LBound(標題) + 1) = 標題


            Table = rsData.GetRows(每頁承載筆數)
            Table = Transpose2(Table)
            Sheets("Data_" & page).Cells(2, 1).Resize(UBound(Table, 1) - LBound(Table, 1) + 1, UBound(Table, 2) - LBound(Table, 2) + 1) = Table
        Next
    End If
    rsData.Close

End Sub

Public Function Get_CSVFile_Object(ByVal File_FullPathName As String) As Object
      Set rs = CreateObject("ADODB.Recordset")
    Set conn = CreateObject("ADODB.Connection")
   
    strFileName = CreateObject("Scripting.FileSystemObject").GetFileName(File_FullPathName)
    strFilePath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(File_FullPathName)
    aa = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source=" & strFilePath & ";" & _
         "Extended Properties='text;HDR=Yes;FMT=Delimited(,);CharacterSet=65001'"
    conn.Open aa, "", ""
   
    Const adOpenStatic = 3, adLockReadOnly = 1, adCmdText = 1
   
    rs.Open "select * from [" & strFileName & "]", conn, adOpenStatic, adLockReadOnly, adCmdText
    Set Get_CSVFile_Object = rs
End Function


Public Function Transpose2(ar2d)
    Dim c1 As Long, c2 As Long
    ReDim out(LBound(ar2d, 2) To UBound(ar2d, 2), LBound(ar2d, 1) To UBound(ar2d, 1)) As String
    For c1 = LBound(ar2d, 1) To UBound(ar2d, 1)
    For c2 = LBound(ar2d, 2) To UBound(ar2d, 2)
        If Not IsNull(ar2d(c1, c2)) Then
           out(c2, c1) = ar2d(c1, c2)
        End If
    Next
    Next
    Transpose2 = out
End Function

TOP

快速倒進 sheet
因沒有提供 倒進 >= sheet2 ...  
所以就不弄這個了

TOP

        靜思自在 : 口說好話、心想好意、身行好事。
返回列表 上一主題