VBA将数据按关键字拆分为文本文件 | VBA实例教程

gblhp 2015-02-16

展开全文

除非注明，文章均为战战如疯原创，转载请保留链接: http://www./cat4/341.html，VBA交流群273624828。

之前我们讲过一个将Excel数据按关键字拆分为不同工作表的例子，今天来看一个将数据大量的Excel数据按关键字拆分为Txt文本文件的例子。现在我有一些井斜数据（我也不知道井斜是啥），现在要按照关键字井号将这近20000条数据拆分为txt文件，并以井号来命名该文件。前面在拆分为工作表的例子中我们用了自动筛选然后复制数据的方法，但在“将Excel内容导出为单个txt”的文章中我们讲到不可以直接向txt中粘贴文本，所以我们还是要用Output方法来将数据输出到txt中。

基本思路是这样的，仍然用字典法将关键字筛选出来，然后以每一个关键字来新建一个txt文件，然后循环判断该关键字所在的行，将符合条件的行都放入该txt中。数据量比较大，必须要将所有数据放入到数组中进行操作，否则速度上会让人不能忍受。下面来看下代码

Sub chaifen()
Dim r, arr, d, k, i, j, brr
Dim rng As Range
Dim sht As Worksheet, Sht1 As Worksheet
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'On Error Resume Next
r = [a65536].End(xlUp).Row
arr = Range("a2:d" & r)
For i = 1 To UBound(arr)
d(arr(i, 1)) = "" '通过字典取不重复的订单编号
Next
k = d.keys '订单编号放入数组k
For j = 0 To UBound(k)
On Error Resume Next
Kill ThisWorkbook.Path & "\" & k(j) & ".txt"
Open ThisWorkbook.Path & "\" & k(j) & ".txt" For Output As #1
For i = 1 To UBound(arr, 1)
If arr(i, 1) = k(j) Then
Print #1, Join(Application.Index(arr, i), ",")
End If
Next i
Close #1
Next j
Set d = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

在将Excel数据按关键字拆分为不同工作表这篇文章中我们用的自动筛选的方法，有人会问了在这里我们也先进行自动筛选，然后再将筛选出的结果放入数组中不行吗？答案是这个确实不行，Excel不支持将不连续的区域放入数组中，当然也许有其他迂回的方法，感兴趣的可以去研究。

还有一个细节问题，数据中有一些小数点前是0的问题，导出到txt中有的会不显示小数点前的0，这个问题可以事先将数字设置为文本格式，但更好的方法是在控制面板中进行设置数值的显示格式。win7下是控制面板-区域和语言-格式中的其他设置-零起始显示，选择小数点前显示0的方式“0.7”，这样的话就不会出现小数点前的0不显示的问题了。

本节示例文件下载：http://pan.baidu.com/s/1mgLt32C。

您可能也喜欢：