[已解决]一列数据变成行的转换，且另存为文本格式。

webroot

现有一列数据，大概有4万行，要把此列数据按每1000行数据排列成一行，每个数据间用“；”作分隔符，每一行另存为一个文本文件，这个VBA该怎么写？

aaaa
bbbb
cccc
dddd
eeee
ffff
变成
aaaa;bbbb;cccc;eeee;ffff

最佳答案

月排行榜 / 总排行榜

qushui

2012-8-19 08:59

”，只有33000，不有在573条！“
楼主这个问题  我在帅哥代码的基础上给完善了一下  帅哥的代码时很好的  我顺着他的思路添加了一段代码  呵呵  代码贴出来  楼主把它贴进帅哥做的表格  给测试下就行了

1. Sub 导出文本()
   
2.     row1 = Sheets(1).Range("A65536").End(xlUp).Row
   
3.     ARR1 = Sheets(1).Range("a1:a" & row1)
   
4.     name1 = ThisWorkbook.Path & "" & "导出文件-" & Format(Date, "yyyymmdd")
   
5.     name1 = name1 & ".txt"
   
6.     Open name1 For Output As #1
   
7.     m = UBound(ARR1) \ 1000
   
8.     For i = 1 To m
   
9.         Do
   
10.             l = l + 1
    
11.             S = S & ARR1((i - 1) * 1000 + l, 1) & ";"
    
12. 
    
13.         Loop While l < 1000
    
14.         Print #1, S
    
15.         Print #1, vbLf
    
16.         l = 0
    
17.         S = ""
    
18.     Next i
    
19.     n = UBound(ARR1) Mod 1000
    
20.     For i = 1 To n
    
21.         S = S & ARR1(m * 1000 + i, 1) & ";"
    
22.     Next i
    
23.     Print #1, S
    
24.     S = ""
    
25.     Close #1
    
26.     MsgBox "数据已导出"
    
27. End Sub

复制代码

跳转到最佳答案楼层

那么的帅

回复 webroot 的帖子

导出数据到文本文件.rar (300.55 KB, 下载次数: 99)

2011-6-17 01:17 上传

点击文件名下载附件

webroot

谢谢，有一个问题，我的数据是33573条记录，你转出的文本统计后，只有33000，不有在573条！

微笑的笛手

真是高手啊，敬仰

qushui

”，只有33000，不有在573条！“
楼主这个问题  我在帅哥代码的基础上给完善了一下  帅哥的代码时很好的  我顺着他的思路添加了一段代码  呵呵  代码贴出来  楼主把它贴进帅哥做的表格  给测试下就行了

1. Sub 导出文本()
   
2.     row1 = Sheets(1).Range("A65536").End(xlUp).Row
   
3.     ARR1 = Sheets(1).Range("a1:a" & row1)
   
4.     name1 = ThisWorkbook.Path & "" & "导出文件-" & Format(Date, "yyyymmdd")
   
5.     name1 = name1 & ".txt"
   
6.     Open name1 For Output As #1
   
7.     m = UBound(ARR1) \ 1000
   
8.     For i = 1 To m
   
9.         Do
   
10.             l = l + 1
    
11.             S = S & ARR1((i - 1) * 1000 + l, 1) & ";"
    
12. 
    
13.         Loop While l < 1000
    
14.         Print #1, S
    
15.         Print #1, vbLf
    
16.         l = 0
    
17.         S = ""
    
18.     Next i
    
19.     n = UBound(ARR1) Mod 1000
    
20.     For i = 1 To n
    
21.         S = S & ARR1(m * 1000 + i, 1) & ";"
    
22.     Next i
    
23.     Print #1, S
    
24.     S = ""
    
25.     Close #1
    
26.     MsgBox "数据已导出"
    
27. End Sub

复制代码