VB把一个超大文本（20M）左右，拆分为指定大小的文本，按行或者按文本大小
发布网友
发布时间：2022-05-20 06:12
共3个回答
热心网友
时间：2023-10-03 11:42
===================================
按行分割缺行已BUG也修正
-----------------------------------
Option Explicit
Dim bByLines As Boolean
Private Sub Command1_Click()
Dim strTmp As String
Dim iFilesrc As Integer
Dim iFileDes As Integer
Dim lCount As Long
Dim lLimit As Long
Dim lFileCT As Long
strTmp = Trim(Text1.Text)
If Not IsNumeric(strTmp) Then
MsgBox "错误：行数或文件大小必须是正整数"
Exit Sub
End If
If Abs(CLng(strTmp)) <> CDbl(strTmp) Or CLng(strTmp) <= 0 Then
MsgBox "错误：行数或文本大小必须为正整数！" '通过修改上边CLng(strTmp)的比较数值，可以设置允许输入的最小值
Exit Sub
End If
lLimit = CLng(strTmp)
iFilesrc = FreeFile
Open "D:\DATA.TXT" For Input As #iFilesrc
lCount = 0
lFileCT = 0
iFileDes = FreeFile
Open "D:\DataSep_" & Format$(lFileCT, "0000") & ".txt" For Output As #iFileDes
Line Input #iFilesrc, strTmp
While Not EOF(iFilesrc)
If bByLines Then
If lCount + 1 > lLimit Then
Close #iFileDes
lFileCT = lFileCT + 1
Open "D:\DataSep_" & Format$(lFileCT, "0000") & ".txt" For Output As #iFileDes
lCount = 1
Else
lCount = lCount + 1
End If
Else
If lCount + 2 + Len(strTmp) > lLimit Then
Close #iFileDes
lFileCT = lFileCT + 1
Open "D:\DataSep_" & Format$(lFileCT, "0000") & ".txt" For Output As #iFileDes
lCount = Len(strTmp) + 2
Else
lCount = lCount + Len(strTmp) + 2
End If
End If
Print #iFileDes, strTmp
If Not EOF(iFilesrc) Then Line Input #iFilesrc, strTmp
Wend
If strTmp <> "" Then
If bByLines Then
If lCount + 1 > lLimit Then
Close #iFileDes
lFileCT = lFileCT + 1
Open "D:\DataSep_" & Format$(lFileCT, "0000") & ".txt" For Output As #iFileDes
lCount = 1
Else
lCount = lCount + 1
End If
Else
If lCount + 2 + Len(strTmp) > lLimit Then
Close #iFileDes
lFileCT = lFileCT + 1
Open "D:\DataSep_" & Format$(lFileCT, "0000") & ".txt" For Output As #iFileDes
lCount = Len(strTmp) + 2
Else
lCount = lCount + Len(strTmp) + 2
End If
End If
Print #iFileDes, strTmp
End If
On Error Resume Next
Close iFilesrc
Close iFileDes
Err.Clear
End Sub
Private Sub Form_Load()
Form1.Width = 6000
Form1.Height = 2400
Option1.Height = 495
Option1.Width = 2100
Option2.Height = 495
Option2.Width = 3735
Option1.Left = 45
Option1.Top = 45
Option2.Left = 90 + Option1.Width
Option2.Top = 45
Label1.Left = 45
Label1.Top = 90 + Option1.Height
Label1.Width = 2535
Label1.Height = 495
Text1.Top = Label1.Top
Text1.Left = 90 + Label1.Width
Text1.Width = 2655
Text1.Height = 330
Text1.Text = ""
Command1.Height = 375
Command1.Width = 1200
Command1.Top = Text1.Top + Text1.Height + 120
Command1.Left = Text1.Left + Text1.Width - Command1.Width - 45
Command1.Caption = "开始分割"
Option1.Caption = "按行数进行文件分割"
Option2.Caption = "按分割文件的最大尺寸进行文件分割"
End Sub
Private Sub Option1_Click()
bByLines = Option1.Value
Label1.Caption = "请输入每个分割文件的行数"
End Sub
Private Sub Option2_Click()
bByLines = Option1.Value
Label1.Caption = "请输入每个分割文件的最大尺寸"
End Sub
热心网友
时间：2023-10-03 11:43
Private Sub Command1_Click()
Dim i As Long, str1 As String, str2 As String
Dim lngB As Long, k As Long
If IsNumeric(Text1.Text) Then
lngB = Val(Text1.Text)
If (Option1.Value And lngB < 10) Or lngB <= 0 Then
Text1.Text = ""
Exit Sub
End If
Else
MsgBox "分隔长度数据错误"
Exit Sub
End If
Open "c:\shuju.txt" For Input As #1
While Not EOF(1)
i = i + 1
Open "c:\shuju" & i & ".txt" For Output As #2
If Option1.Value Then
str2 = str1
Do While Not EOF(1)
Line Input #1, str1
If Len(str2 & vbCrLf & str1) >= lngB Then Exit Do
str2 = str2 & str1 & vbCrLf
Loop
Else
str2 = ""
k = 0
Do While Not EOF(1)
Line Input #1, str1
k = k + 1
If k >= lngB Then Exit Do
str2 = str2 & str1 & vbCrLf
Loop
End If
Close #2
Wend
Close #1
End Sub
Private Sub Form_Load()
Option1.Caption = "按字节数分隔"
Option1.Value = True
Option1.Caption = "按行数分隔"
End Sub
Private Sub Option1_Click()
Text1.Text = 1024
End Sub
Private Sub Option2_Click()
Text1.Text = 10
End Sub
热心网友
时间：2023-10-03 11:43
如果1楼的代码高不定的话
email to happyq6@163.com
我来做吧
