请问如何利用VBA将Excel表格内容按照要求分割为若干txt文件?

2025-03-05 10:58:59
推荐回答(3个)
回答1:

我的思路是先用代码里做筛选,再把筛选结果写入txt文件。给你一段代码试试
Sub 筛选后输出到文本()
Application.ScreenUpdating = False
Dim clas As Variant
Dim iRow%, iPath$, iFileName$, filReg As Range
Dim fso As Object, sfile As Object
clas = Array(1, 2, 3)
iPath = ThisWorkbook.Path

Columns("P:T").Clear
Columns("F:G").Clear
If ActiveSheet.AutoFilterMode = True Then Range("a1").CurrentRegion.AutoFilter
Range("a1").CurrentRegion.Sort key1:=Range("a1"), key2:=Range("b1"), Order2:=xlAscending, Header:=xlGuess
For I = 0 To UBound(clas)
With ActiveSheet.Range("a1")
Range("G1") = "班级": Range("G2") = clas(I)
.CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("g1:g2"), _
copytorange:=Range("p1")
Set filReg = Range("p1").CurrentRegion
iFileName = iPath & "\" & clas(I) & "班成绩.txt"
Set fso = CreateObject("scripting.filesystemobject")
If fso.fileexists(iFileName) Then fso.deletefile (iFileName)
Set sfile = fso.createtextfile(iFileName)
sfile.writeline (Application.Rept(" ", 10) & clas(I) & "班成绩表")
For j = 1 To filReg.Rows.Count
sfile.writeline (filReg.Cells(j, 2) & Chr$(9) & _
filReg.Cells(j, 3) & Chr$(9) & _
filReg.Cells(j, 4) & Chr$(9) & _
filReg.Cells(j, 5) & Chr$(9))
Next j
Columns("P:T").Clear
End With
Set fso = Nothing
Set sfile = Nothing
Next I
Columns("F:G").Clear
Application.ScreenUpdating = True
End Sub

回答2:

可以扩展多科的:
Sub test()
Dim arr, i%, j%, tmp$
Set d = CreateObject("Scripting.Dictionary")
arr = ActiveSheet.[a1].CurrentRegion
For i = 2 To UBound(arr)
tmp = ""
If d.exists(arr(i, 1)) = False Then
d(arr(i, 1)) = arr(1, 2)
For j = 3 To UBound(arr, 2)
d(arr(i, 1)) = d(arr(i, 1)) & vbTab & arr(1, j)
Next
End If
For j = 2 To UBound(arr, 2)
If tmp = "" Then tmp = arr(i, j) Else tmp = tmp & vbTab & arr(i, j)
Next
d(arr(i, 1)) = d(arr(i, 1)) & vbCrLf & tmp
Next
a = d.keys: b = d.Items
For i = 0 To d.Count - 1
Open ThisWorkbook.Path & "\" & a(i) & ".txt" For Output As #1
Print #1, b(i)
Close #1
Next
MsgBox "已完成,生成文件在本文件同目录下。"
End Sub

回答3:

其实就是一个拆分代码