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

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

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

¥»©«³Ì«á¥Ñ 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

¦^´_ 6# paul3063

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

TOP

ÁÙ¯u¬OºC§r

­è¦³¸Õ¹L¤@­Ó¤èªk
¥i¥H§â­Ë¶i sheet ªº¯Ó®É­°¨ì 1/6
¤£¹L­ì½X¨S¦³´£¨Ñ ­Ë¶i¦hsheet

TOP

¥»©«³Ì«á¥Ñ jackyq ©ó 2018-1-17 19:58 ½s¿è

Public Sub «ó§Ú______()
   
    Dim rsData As Object

    Csv = "C:\Documents and Settings\Administrator\My Documents\Downloads\36_2.csv\36_2.csv"   ' ¦Û¤v§ï¦¨Àɮׯu¹ê¸ô®|

    Set rsData = Get_CSVFile_Object(Csv)
   
   
    ¨C­¶©Ó¸üµ§¼Æ = 10000
    page_count = (rsData.RecordCount \ ¨C­¶©Ó¸üµ§¼Æ) + Sgn(rsData.RecordCount Mod ¨C­¶©Ó¸üµ§¼Æ)
   
    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 ¼ÐÃD(0 To rsData.Fields.Count) As String
        For w = 0 To rsData.Fields.Count - 1
            ¼ÐÃD(w) = rsData.Fields(w).Name
        Next

        For page = 1 To page_count
            Sheets("Data_" & page).Select
            Sheets("Data_" & page).Cells(1, 1).Resize(, UBound(¼ÐÃD) - LBound(¼ÐÃD) + 1) = ¼ÐÃD


            Table = rsData.GetRows(¨C­¶©Ó¸üµ§¼Æ)
            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

§Ö³t­Ë¶i sheet
¦]¨S¦³´£¨Ñ ­Ë¶i >= sheet2 ...  
©Ò¥H´N¤£§Ë³o­Ó¤F

TOP

        ÀR«ä¦Û¦b : ºw¤ô¦¨ªe¡C²É¦Ì¦¨ÅÚ¡A¤Å»´¤vÆF¡A¤Å¥Hµ½¤p¦Ó¤£¬°¡C
ªð¦^¦Cªí ¤W¤@¥DÃD