返回列表 上一主題 發帖

[發問] 如何在不打開檔案下,將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

回復 17# GBKEE

謝謝大家

TOP

回復 14# jackyq
2003 版
Public Sub 扁我______() 對照  #8 的 Sub Ex_CVS的分割()  中 找出一些差異


[Book1]Sheet1!$L$979 字元數1000        [Book1]Sheet3!$L$3692 字元數1000
[Book1]Sheet1!$L$2160 字元數1000        [Book1]Sheet3!$L$3693 字元數1000
[Book1]Sheet1!$L$2161 字元數1000        [Book1]Sheet3!$M$5833 字元數988
[Book1]Sheet1!$Q$2529 字元數1042        [Book1]Sheet3!$M$5834 字元數988
[Book1]Sheet2!$M$3438 字元數988        [Book1]Sheet3!$L$6259 字元數1000
[Book1]Sheet2!$M$3474 字元數988        [Book1]Sheet3!$L$6260 字元數1000
[Book1]Sheet2!$AD$4019 字元數1058        [Book1]Sheet3!$Q$6409 字元數1067
[Book1]Sheet2!$M$4027 字元數988        [Book1]Sheet3!$M$7768 字元數988
[Book1]Sheet2!$M$4083 字元數988        [Book1]Sheet3!$M$9390 字元數988
[Book1]Sheet2!$AD$4090 字元數1058        [Book1]Sheet3!$M$9391 字元數988
[Book1]Sheet2!$M$4578 字元數988        [Book1]Sheet4!$Q$2957 字元數1067
[Book1]Sheet2!$M$4615 字元數988        [Book1]Sheet4!$Q$3005 字元數1067
[Book1]Sheet2!$M$4618 字元數988        [Book1]Sheet4!$Q$4840 字元數1028
[Book1]Sheet2!$M$4703 字元數988        [Book1]Sheet4!$Q$4841 字元數1028
[Book1]Sheet2!$M$4909 字元數988        [Book1]Sheet4!$Q$8504 字元數1028
[Book1]Sheet2!$M$4910 字元數988        [Book1]Sheet5!$AC$2302 字元數1759
[Book1]Sheet2!$M$4942 字元數988        [Book1]Sheet5!$AA$9490 字元數1282
[Book1]Sheet2!$M$4943 字元數988        [Book1]Sheet6!$Q$5208 字元數1204
[Book1]Sheet2!$AD$5049 字元數1058        [Book1]Sheet6!$Q$5563 字元數1024
[Book1]Sheet2!$AD$5050 字元數1058        [Book1]Sheet7!$AD$1329 字元數1058
[Book1]Sheet2!$AD$7966 字元數1759        [Book1]Sheet7!$AB$1333 字元數1058
[Book1]Sheet2!$AB$9480 字元數1759        [Book1]Sheet7!$AA$5423 字元數945
[Book1]Sheet2!$Q$9482 字元數1024
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 11# paul3063

8#這段程式碼就是 處理工作表不存在 ,請練習看看
  1. XER:
  2.     Dim ii
  3.      '處理程式中 Sheets(i).Cells.Clear ˇ的錯誤
  4.     If Err = 9 Then ThisWorkbook.Sheets.Add , Sheets(Sheets.Count): Resume
  5.      '處理程式中 .Resize(, UBound(Ar) + 1) = Ar ˇ的錯誤
  6.    '2003 **陣列的元素字元數大於255 個字元,會有錯誤
  7.    '2003 以後的版本沒有此錯誤
  8.     For ii = 0 To UBound(Ar)
  9.         Sheets(Sh).Cells(i + Sh - X, ii + 1) = Ar(ii)
  10.         If Len(Ar(ii)) > 456 Then
  11.         Debug.Print Sh, i + 1 - X, ii, Len(Ar(ii))
  12.         End If
  13.     Next
  14.     Resume Next
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

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 的耗時降到 1/6
不過原碼沒有提供 倒進多sheet

TOP

回復  GBKEE

GBKEE大,如果目前工作表裡面沒有SHEET1和SHEET2,怎辦?
因為我在做測試的時候砍光了SHEE ...
paul3063 發表於 2018-1-17 17:06


只剩下SHEET13,直接將 SHEET13 表單名稱改成 SHEET1 便可以了,以此類推。

TOP

回復 10# GBKEE

GBKEE大,如果目前工作表裡面沒有SHEET1和SHEET2,怎辦?
因為我在做測試的時候砍光了SHEET,只剩下SHEET13
要怎樣修改程式碼?

TOP

本帖最後由 GBKEE 於 2018-1-17 11:21 編輯

回復 9# paul3063

QueryTable 是沒有終止列這屬性
你的程式碼在2003運行還是受到65536列的限制
如圖
未命名.jpg
2018-1-17 11:12

修改程式看看 2003,2010 的差異
  1. Option Explicit
  2. Sub Macro4()
  3.    Dim i As Integer
  4.     For i = 1 To IIf(Rows.Count > 65536, 1, 2)
  5.         With Sheets(i).QueryTables.Add(Connection:="TEXT;d:\excel\36_2.csv" _
  6.             , Destination:=Sheets(i).Range("A" & i))
  7.             .Name = "36_4"
  8.             .FieldNames = True
  9.             .RowNumbers = True
  10.             .RefreshStyle = xlInsertDeleteCells
  11.             .SaveData = True
  12.             .AdjustColumnWidth = False  '自動將欄寬調整為最適合的大小
  13.             .TextFilePlatform = -535
  14.             .TextFileStartRow = IIf(i = 1, 1, 32767)
  15.             .TextFileCommaDelimiter = True '***
  16.             .Refresh BackgroundQuery:=False
  17.     End With
  18.     If i = 2 Then Sheets(2).Rows(1) = Sheets(1).Rows(1).Value
  19.     Next
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 做該做的事是智慧,做不該做的事是愚癡。
返回列表 上一主題