返回列表 上一主題 發帖

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

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

如何在不打開檔案下,將XML檔或CSV檔匯入EXCEL中
網址如下
https://data.gov.tw/dataset/9122
下載XML檔,JSON檔跟CSV檔
卻發現XML檔和JSON檔打不開
CSV檔可以
可是資料龐大,
超過65536列
出現文字檔案多於能容納的資料
使用文字匯入精靈來排除已經匯入的資料
請問有什麼辦法將資料快速平均匯入到SHEET1跟SHEET2跟SHEET3
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

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

TOP

回復 2# jackyq


請問可以用CreateObject("ADODB.CONNECTION")的方法嗎
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

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

回復 5# jackyq


    請問程式碼要放在那裡?
THISWORKBOOK裡面
還是MODULE裡面?
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 6# paul3063

放 module 好了
不過要把 private 字樣 改成 public
不然會呼叫不到
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

本帖最後由 GBKEE 於 2018-1-12 08:53 編輯

回復 6# paul3063
放那裡都可以,2003跑程式約需2分鐘,其他版本約8-10秒
試試看
  1. Option Explicit
  2. Sub Ex_CVS的分割()
  3.     Dim i As Long, S As Variant, Ar As Variant, X As Long, xData As Long, Sh As Integer, xTime As Date
  4.     xTime = Time
  5.     On Error GoTo XER
  6.     With CreateObject("Microsoft.XMLHTTP")
  7.         .Open "POST", "D:\EXCEL\36_2.csv", 0
  8.         .send
  9.         S = Split(.responseText, vbCrLf)
  10.     End With
  11.     xData = 20000 '**每一工作表分割資料數 20000
  12.     Ar = Replace(S(0), """,""", ",")
  13.     Ar = Replace(Ar, """", "")
  14.     Ar = Split(Ar, ",")
  15.    
  16.     For i = 1 To Application.Ceiling(UBound(S) / xData, 1)
  17.         Sheets(i).Cells.Clear
  18.         Sheets(i).Cells(1, "a").Resize(, UBound(Ar) + 1) = Ar
  19.     Next
  20.     Sh = 1
  21.     For i = 1 To UBound(S)
  22.         If i >= xData And i Mod xData = 0 Then Sh = Sh + 1: X = (xData) * (Sh - 1) - 1
  23.         Ar = Replace(S(i), """,""", ",")
  24.         Ar = Replace(Ar, """", "")
  25.         Ar = Split(Ar, ",")
  26.         Sheets(Sh).Cells(i + 1 - X, "a").Resize(, UBound(Ar) + 1) = Ar
  27.     Next
  28.     MsgBox Application.Text(Time - xTime, "[S]秒") & " ok"
  29. Exit Sub
  30. XER:
  31.   
  32.     Dim ii
  33.      '處理程式中 Sheets(i).Cells.Clear ˇ的錯誤
  34.     If Err = 9 Then ThisWorkbook.Sheets.Add , Sheets(Sheets.Count): Resume
  35.      '處理程式中 .Resize(, UBound(Ar) + 1) = Ar ˇ的錯誤
  36.    '2003 **陣列的元素字元數大於255 個字元,會有錯誤
  37.    '2003 以後的版本沒有此錯誤
  38.     For ii = 0 To UBound(Ar)
  39.         Sheets(Sh).Cells(i + Sh - X, ii + 1) = Ar(ii)
  40.         If Len(Ar(ii)) > 456 Then
  41.         Debug.Print Sh, i + 1 - X, ii, Len(Ar(ii))
  42.         End If
  43.     Next
  44.     Resume Next

  45. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 8# GBKEE

GBKEE大,
我用匯入的方法好像比較快
可是匯入的方法只有起始列
沒有終止列真的很奇怪

Sub Macro4()
    Range("A1").Select
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Documents and Settings\Administrator\My Documents\Downloads\36_2.csv\36_2.csv" _
        , Destination:=Range("A1"))
        .Name = "36_4"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = -535
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("D6").Select
    Sheets("Sheet1").Select
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Documents and Settings\Administrator\My Documents\Downloads\36_2.csv\36_2.csv" _
        , Destination:=Range("A1"))
        .Name = "36_4"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = -535
        .TextFileStartRow = 30001
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

        靜思自在 : 口說一句好話,如口出蓮花;口說一句壞話如口吐毒蛇。
返回列表 上一主題