[µo°Ý] ¦p¦ó¦b¤£¥´¶}ÀɮפU¡A±NXMLÀÉ©ÎCSVÀɶפJEXCEL¤¤

paul3063

¦p¦ó¦b¤£¥´¶}ÀɮפU¡A±NXMLÀÉ©ÎCSVÀɶפJEXCEL¤¤
ºô§}¦p¤U
https://data.gov.tw/dataset/9122
¤U¸üXMLÀÉ¡AJSONÀɸòCSVÀÉ
«oµo²{XMLÀÉ©MJSONÀÉ¥´¤£¶}
CSVÀÉ¥i¥H
¥i¬O¸ê®ÆÃe¤j¡A
¶W¹L65536¦C
¥X²{¤å¦rÀɮצh©ó¯à®e¯Çªº¸ê®Æ
¨Ï¥Î¤å¦r¶×¤JºëÆF¨Ó±Æ°£¤w¸g¶×¤Jªº¸ê®Æ
½Ð°Ý¦³¤°»ò¿ìªk±N¸ê®Æ§Ö³t¥­§¡¶×¤J¨ìSHEET1¸òSHEET2¸òSHEET3

jackyq

¤èªk1: csv ®æ¦¡«Ü²³æ, ¦Û¤v¼g­Ó¸ÑªR¾¹,  «Ü®e©ö´N¥i¥H¶×¤J ( ¤£µM google À³¸Ó¥i¥H§ä±o¨ì²{¦¨ªº )
¤èªk2:
¥Î Open CSV_FileName For Input As #1 §â csv¤jÀÉ ¤Á³Î¦¨¤p©ó 65536 ¦Cªº ¼Æ­Ó¤p csv ÀÉ
¦A§â³o¨Ç¤p csv ³v¤@¶×¤J¨ì sheet1, sheet2 ....

paul3063

¦^´_ 2# jackyq


½Ð°Ý¥i¥H¥ÎCreateObject("ADODB.CONNECTION")ªº¤èªk¶Ü

jackyq

¦^´_ 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"   ' ¦Û¤v§ï¦¨Àɮׯu¹ê¸ô®|

    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

jackyq

¦^´_ 3# paul3063

§â¸ê®Æ¤À¬£¨ì sheet1 , sheet2 ..

³Ò·Ð¤j¤j¦Û¤v³B¸Ì

paul3063

¦^´_ 5# jackyq


    ½Ð°Ýµ{¦¡½X­n©ñ¦b¨º¸Ì?
THISWORKBOOK¸Ì­±
ÁÙ¬OMODULE¸Ì­±?

jackyq

¦^´_ 6# paul3063

©ñ module ¦n¤F
¤£¹L­n§â private ¦r¼Ë §ï¦¨ public
¤£µM·|©I¥s¤£¨ì

GBKEE

¦^´_ 6# paul3063
©ñ¨º¸Ì³£¥i¥H,2003¶]µ{¦¡¬ù»Ý2¤ÀÄÁ,¨ä¥Lª©¥»¬ù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.     Dim Msg As String
   
5.     xTime = Time
   
6.     On Error GoTo XER
   
7.     With CreateObject("Microsoft.XMLHTTP")
   
8.         .Open "POST", "D:\EXCEL\36_2.csv", 0
   
9.         .send
   
10.         S = Split(.responseText, vbCrLf)
    
11.     End With
    
12.     xData = 10000 '**¨C¤@¤u§@ªí¤À³Î¸ê®Æ¼Æ 10000
    
13.     Ar = Replace(S(0), """,""", ",")
    
14.     Ar = Replace(Ar, """", "")
    
15.     Ar = Split(Ar, ",")
    
16.    
    
17.     For i = 1 To Application.Ceiling(UBound(S) / xData, 1)
    
18.         Sheets(i).Cells.Clear
    
19.         Sheets(i).Cells(1, "a").Resize(, UBound(Ar) + 1) = Ar
    
20.     Next
    
21.     Sh = 1
    
22.     X = 2
    
23.     For i = 1 To UBound(S)
    
24.         If i >= xData And i Mod xData = 0 Then Sh = Sh + 1: X = 2
    
25.         Ar = Replace(S(i), """,""", ",")
    
26.         Ar = Replace(Ar, """", "")
    
27.         Ar = Split(Ar, ",")
    
28.         Sheets(Sh).Cells(X, "a").Resize(, UBound(Ar) + 1) = Ar
    
29.         X = X + 1
    
30.     Next
    
31.     MsgBox Application.Text(Time - xTime, ["m¤À:S¬í"]) & " ok"
    
32.     If Msg <> "" Then
    
33.         MsgBox Msg
    
34.         ThisWorkbook.Sheets.Add , Sheets(Sheets.Count)
    
35.         Ar = Application.Transpose(Split(Msg, vbLf))
    
36.         ActiveSheet.Range("a1").Resize(UBound(Ar) + 1) = Ar
    
37.     End If
    
38. Exit Sub
    
39. XER:
    
40.   
    
41.     Dim ii
    
42.      '³B²zµ{¦¡¤¤ Sheets(i).Cells.Clear £¾ªº¿ù»~
    
43.     If Err = 9 Then ThisWorkbook.Sheets.Add , Sheets(Sheets.Count): Resume
    
44.      '³B²zµ{¦¡¤¤ .Resize(, UBound(Ar) + 1) = Ar £¾ªº¿ù»~
    
45.    '2003 **°}¦Cªº¤¸¯À¦r¤¸¼Æ¤j©ó255 ­Ó¦r¤¸,·|¦³¿ù»~
    
46.    '2003 ¥H«áªºª©¥»¨S¦³¦¹¿ù»~
    
47.     For ii = 0 To UBound(Ar)
    
48.         Sheets(Sh).Cells(X, ii + 1) = Ar(ii)
    
49.         If Len(Ar(ii)) > 456 Then
    
50.             Msg = Msg & Sheets(Sh).Cells(X, ii + 1).Address(, , , 1, 1) & " ¦r¤¸¼Æ" & Len(Ar(ii)) & vbLf
    
51.         End If
    
52.     Next
    
53.     Resume Next
    
54. 
    
55. End Sub

½Æ»s¥N½X

paul3063

¦^´_ 8# GBKEE

GBKEE¤j¡A
§Ú¥Î¶×¤Jªº¤èªk¦n¹³¤ñ¸û§Ö
¥i¬O¶×¤Jªº¤èªk¥u¦³°_©l¦C
¨S¦³²×¤î¦C¯uªº«Ü©_©Ç

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

GBKEE

¦^´_ 9# paul3063

QueryTable ¬O¨S¦³²×¤î¦C³oÄÝ©Ê
§Aªºµ{¦¡½X¦b2003¹B¦æÁÙ¬O¨ü¨ì65536¦Cªº­­¨î
¦p¹Ï

¤U¸ü (314.63 KB)

2018-1-17 11:12

­×§ïµ{¦¡¬Ý¬Ý 2003,2010 ªº®t²§

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  '¦Û°Ê±NÄæ¼e½Õ¾ã¬°³Ì¾A¦Xªº¤j¤p
    
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

½Æ»s¥N½X