超200万行数据拆分！求助！

1朝风月3

一把小刀闯天下 发表于 2018-7-24 15:58
'会有假死机现象，可以在do...loop中加入doevents

Option Explicit

真的很感谢您，我试试！

魂断蓝桥

1朝风月3 发表于 2018-7-25 09:13
真的很感谢您，我试试！

先把数据导入access 然后再拆分就可以了。

上传个例子。

crazy0qwer

1朝风月3 发表于 2018-7-24 15:30
求大佬指导！

分割成指定大小，行数不定，同一行不会分成两个文件，速度快。

1. Option Explicit
   
2. 
   
3. Private Sub Form_Click()
   
4.     Dim I As Long, FileSize As Long
   
5.     Dim FilePath As String
   
6.     N = TXT_CUT("D:\123\123.csv", 8000000)
   
7.     If N > 0 Then
   
8.         MsgBox "共生成文件  " & N & " 个", vbOKOnly, "提示"
   
9.     Else
   
10.         MsgBox "分割失败，请检查文件及函数参数", vbOKOnly, "提示"
    
11.     End If
    
12. End Sub
    
13. 
    
14. Public Function TXT_CUT(sFileName As String, lLength As Long) As Long
    
15.     '函数功能：快速将指定文件分割成指定大小文件，生成的文件保存于原文件目录。
    
16.     'sFileName:文件全路径。
    
17.     'lLength： 分割后单个文件大小，单位<字节> 。
    
18.     'TXT_CUT： 返回最终分割出的文件个数。
    
19.     Dim sStr() As Byte, ssstr() As Byte
    
20.     Dim lSize As Long, FileNumber1 As Long, FileNumber2 As Long
    
21.     Dim I As Long, J As Long, K As Long, N As Long
    
22.     Dim FileName As String, sPath As String, FileType As String
    
23.     If Dir(sFileName) = "" Then Exit Function
    
24.     ReDim ssstr(lLength - 1)
    
25.     sPath = Left(sFileName, InStrRev(sFileName, ".") - 1)
    
26.     FileType = Mid(sFileName, InStrRev(sFileName, "."))
    
27.     FileNumber1 = FreeFile
    
28.     Open sFileName For Binary As FileNumber1
    
29.         lSize = LOF(FileNumber1)
    
30.         For I = 0 To lSize \ lLength - 1
    
31.             ReDim sStr(lLength - 1)
    
32.             Get FileNumber1, I * lLength + 1, sStr
    
33.             FileNumber2 = FreeFile
    
34.             FileName = sPath & "-" & I + 1 & FileType
    
35.             If Dir(FileName) <> "" Then Kill FileName
    
36.             Open FileName For Binary As FileNumber2
    
37.                 For K = ssstr(0) - N To 1 Step -1
    
38.                     Put FileNumber2, , ssstr(K)
    
39.                 Next
    
40.                 ssstr(0) = 0
    
41.                 For J = UBound(sStr) To 0 Step -1
    
42.                     ssstr(0) = ssstr(0) + 1
    
43.                     ssstr(ssstr(0)) = sStr(J)
    
44.                     If sStr(J) = 10 Or sStr(J) = 13 Then
    
45.                         N = 1
    
46.                         If sStr(J - 1) = 10 Or sStr(J - 1) = 13 Then
    
47.                             N = 2
    
48.                             ssstr(0) = ssstr(0) + 1
    
49.                             ssstr(ssstr(0)) = sStr(J - 1)
    
50.                             Exit For
    
51.                         Else
    
52.                             Exit For
    
53.                         End If
    
54.                     End If
    
55.                 Next
    
56.                 ReDim Preserve sStr(UBound(sStr) - ssstr(0))
    
57.                 Put FileNumber2, , sStr
    
58.             Close FileNumber2
    
59.         Next
    
60.         ReDim sStr(lSize - I * lLength - 1)
    
61.         Get FileNumber1, I * lLength + 1, sStr
    
62.         FileNumber2 = FreeFile
    
63.         FileName = sPath & "-" & I + 1 & ".csv"
    
64.         If Dir(FileName) <> "" Then Kill FileName
    
65.         Open FileName For Binary As FileNumber2
    
66.             For K = ssstr(0) - N To 1 Step -1
    
67.                 Put FileNumber2, , ssstr(K)
    
68.             Next
    
69.             Put FileNumber2, , sStr
    
70.         Close FileNumber2
    
71.     Close FileNumber1
    
72.     TXT_CUT = I + 1
    
73. End Function
    

复制代码

crazy0qwer

1朝风月3 发表于 2018-7-25 09:13
真的很感谢您，我试试！

重复，删除。