ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¦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

¤èª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 ....

TOP

¦^´_ 2# jackyq


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

TOP

¥»©«³Ì«á¥Ñ jackyq ©ó 2018-1-9 09:32 ½s¿è

¦^´_ 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

TOP

¦^´_ 3# paul3063

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

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

TOP

¦^´_ 5# jackyq


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

TOP

¦^´_ 6# paul3063

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

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-1-18 17:05 ½s¿è

¦^´_ 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. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 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

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-1-17 11:21 ½s¿è

¦^´_ 9# paul3063

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

­×§ïµ{¦¡¬Ý¬Ý 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD