EXCEL VBA 判断单元格内容 相同 批量导出为TXT文档
请教老师!五十行左右,四列的表格,D列单元格内容相同的话,将A,B,C列的内容存为以D列内容相同的单元格内容为名称的TXT文件,批量导出!例如:1111.TXT内容为:A...
请教老师!五十行左右,四列的表格,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以此类推!以往都是每天手工复制粘贴,比较繁琐!感谢帮助!
只有这么多分,学习了! 展开
为名称的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以此类推!以往都是每天手工复制粘贴,比较繁琐!感谢帮助!
只有这么多分,学习了! 展开
3个回答
展开全部
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
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
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
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
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圆满解决!谢谢您!
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
可以用VBA写个程序
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |