EXCEL VBA 判断单元格内容相同批量导出为TXT文档

请教老师！五十行左右，四列的表格，D列单元格内容相同的话，将A,B,C列的内容存为以D列内容相同的单元格内容

为名称的TXT文件，批量导出！例如：1111.TXT 内容为：AAAA 2015-11-19 100BBBB 2015-11-20 100CCCC 2015-11-21 1012222.TXT 内容为：EEEE 2015-11-22 120FFFF 2015-11-23 130以此类推！以往都是每天手工复制粘贴，比较繁琐！感谢帮助！

只有这么多分，学习了！

举报该问题

其他回答

第1个回答 2015-11-21

Sub T()
outpath = "C:\Users\Administrator\Desktop\"
prefilename = ""
For i = 2 To [a65535].End(xlUp).Row()
curfilename = Cells(i, 4)
If curfilename <> prefilename Then
If prefilename <> "" Then Close #1
Open outpath & curfilename & ".txt" For Output As #1
prefilename = curfilename
End If

sLine = Cells(i, 1).Text & " " & Cells(i, 2).Text & " " & Cells(3).Text
Print #1, sLine

Next
Close #1
End Sub追问

感谢老师的帮助！输出的txt文档中，C列的数值都是相同的，全是C1的内容！麻烦您再看一下！谢谢！

追答

sLine = Cells(i, 1).Text & " " & Cells(i, 2).Text & " " & Cells(i,3).Text

不好意思没注意这里少了一个i

本回答被提问者采纳

第2个回答 2015-11-21

Sub SplitDataSaveToTxt()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim r, StartRow, EndRow As Long
Dim FilePath, FileName As String

Dim ws1, ws2 As Worksheet
Set ws1 = ActiveSheet
Set ws2 = Sheets.Add(After:=ActiveSheet)
ws1.Select
FilePath = ThisWorkbook.Path

r = Range("D1048576").End(xlUp).Row
StartRow = 2
For i = 2 To r
If Cells(i, "D") <> Cells(i + 1, "D") Then
EndRow = i
FileName = Cells(EndRow, "D")
ws2.Cells.Clear
Rows(StartRow & ":" & EndRow).Copy ws2.Range("A2")
ws2.Copy

ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWorkbook.Close 0
StartRow = i + 1
End If
Next
ws2.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub追问

感谢您的回复，问题已经由504圆满解决！谢谢您！

第3个回答 2015-11-21

可以用VBA写个程序

相似回答

大家正在搜

EXCEL VBA 判断单元格内容 相同 批量导出为TXT文档

EXCEL VBA 判断单元格内容相同批量导出为TXT文档