如何用EXCEL批量处理TXT并将结果自动录入EXCEL

yangyangzhifeng · 发表于 2012-12-19 23:19

放眼TOT 发表于 2012-12-19 23:01
sp2 = sp2 + Abs(Val(brr(6)) - (Val(brr(24)) + Val(brr(25))) / 2) / Val(brr(6))
我改了一下您的这段 ...

单元格地址是从1开始，而数组下标从0开始，所以那些数字没错

放眼TOT · 发表于 2012-12-19 23:32

yangyangzhifeng 发表于 2012-12-19 23:18
程序是照你的要求设计的，检查一下是不是你的文本文件数据本来就有差错，也没有表头都不知道这些数据是什 ...

就是计算的股票买卖价格的两个利差。Spread1就是第43列的平均值。Spread2是求2*绝对值（P2-P1）/P2得出的数据的平均值,其中P2是第7列的值，而P1=（P3+P4）/2,P3是第25列而P4是第26列。我检查了数据，没有错诶。

呜呜都运行成功了，，，不懂为啥就是得出的结果差一点点啊。。麻烦您对照一下我录制宏的那个代码看看？我录制宏的代码在1楼附件里有。

yangyangzhifeng · 发表于 2012-12-20 08:16

放眼TOT 发表于 2012-12-19 23:32
就是计算的股票买卖价格的两个利差。Spread1就是第43列的平均值。Spread2是求2*绝对值（P2-P1）/P2得出的 ...

你的原始数值有的为空，你录的宏计算Spread2总是等于0，程序修改如下

Sub test()
Dim Arr, k&, ph$, fl$, sp1#, sp2#, brr, i&, x&, l&
Dim crr(), n&
ph = ThisWorkbook.Path & ""
fl = Dir(ph & "*.txt")
Do While fl <> ""
Open ph & fl For Input As #1
Arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Reset
k = UBound(Arr) + 1: x = UBound(Arr): l = k
sp1 = 0: sp2 = 0
For i = 0 To x
If Arr(i) <> "" Then
brr = Split(Arr(i), ",")
If brr(42) <> "" Then sp1 = sp1 + Val(brr(42)) Else k = k - 1
If Val(brr(6)) <> 0 Then sp2 = sp2 + Abs(Val(brr(6)) - (Val(brr(24)) + Val(brr(25))) / 2) / Val(brr(6)) Else l = l - 1
Else
k = k - 1
End If
Next
sp1 = sp1 / k: sp2 = sp2 / l
n = n + 1
ReDim Preserve crr(1 To 3, 1 To n)
crr(1, n) = brr(0)
crr(2, n) = sp1
crr(3, n) = sp2
fl = Dir
Loop
Sheet2.Range("a2:c" & Rows.Count).ClearContents
Sheet2.Range("a2").Resize(n, 3) = Application.Transpose(crr)
End Sub

复制代码

放眼TOT · 发表于 2012-12-20 12:52

yangyangzhifeng 发表于 2012-12-20 08:16
你的原始数值有的为空，你录的宏计算Spread2总是等于0，程序修改如下

求出的spread1对了！激动！！
但是Spread2值还是跟之前您未修改前的代码得到的结果一样的，
我自己在我这运行我录制的宏能得出结果诶。。
因为计算spread2所用到的第7列（G列）的数据有些为0，所以用公式2*ABS(G1-(Y1+Z1)/2)/G1求出的值有些是#DIV/0! ，这些值也是要和空值一样排除的，是不是这个原因所以不正确呢。您再修改试试好么，非常感谢您的耐心，不嫌弃我麻烦TAT，谢谢谢谢！！！！

放眼TOT · 发表于 2012-12-20 12:59

我刚刚从1楼下了我上传的那个数据，先打开那个TXT文件为EXCEL，再运行我录制的那个代码，可以得到结果啊，怎么会到您那儿就成了0呢。。。奇怪。。那您就按我在22楼解释的数据的计算过程来吧，，，谢谢！！。。

yangyangzhifeng · 发表于 2012-12-20 14:38

放眼TOT 发表于 2012-12-20 12:59
我刚刚从1楼下了我上传的那个数据，先打开那个TXT文件为EXCEL，再运行我录制的那个代码，可以得到结果啊，怎 ...

再看看

Sub test()
Dim Arr, k&, ph$, fl$, sp1#, sp2#, brr, i&, x&, l&
Dim crr(), n&
ph = ThisWorkbook.Path & ""
fl = Dir(ph & "*.txt")
Do While fl <> ""
Open ph & fl For Input As #1
Arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Reset
k = UBound(Arr) + 1: x = UBound(Arr): l = k
sp1 = 0: sp2 = 0
For i = 0 To x
If Arr(i) <> "" Then
brr = Split(Arr(i), ",")
If brr(42) <> "" Then sp1 = sp1 + Val(brr(42)) Else k = k - 1
If Val(brr(6)) <> 0 Then sp2 = sp2 + Abs(Val(brr(6)) - (Val(brr(24)) + Val(brr(25))) / 2) / Val(brr(6)) Else l = l - 1
Else
k = k - 1: l = l - 1
End If
Next
sp1 = sp1 / k: sp2 = sp2 / l
n = n + 1
ReDim Preserve crr(1 To 3, 1 To n)
crr(1, n) = brr(0)
crr(2, n) = sp1
crr(3, n) = sp2
fl = Dir
Loop
Sheet2.Range("a2:c" & Rows.Count).ClearContents
Sheet2.Range("a2").Resize(n, 3) = Application.Transpose(crr)

复制代码

放眼TOT · 发表于 2012-12-20 14:58

yangyangzhifeng 发表于 2012-12-20 14:38
再看看

Spread2还是不对，跟您前面给的代码得出的结果一样。。。。

yangyangzhifeng · 发表于 2012-12-20 15:09

放眼TOT 发表于 2012-12-20 14:58
Spread2还是不对，跟您前面给的代码得出的结果一样。。。。

这下应该可以了

Sub test()
Dim Arr, k&, ph$, fl$, sp1#, sp2#, brr, i&, x&, l&
Dim crr(), n&
ph = ThisWorkbook.Path & ""
fl = Dir(ph & "*.txt")
Do While fl <> ""
Open ph & fl For Input As #1
Arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Reset
k = UBound(Arr) + 1: x = UBound(Arr): l = k
sp1 = 0: sp2 = 0
For i = 0 To x
If Arr(i) <> "" Then
brr = Split(Arr(i), ",")
If brr(42) <> "" Then sp1 = sp1 + Val(brr(42)) Else k = k - 1
If Val(brr(6)) <> 0 Then sp2 = sp2 + 2 * Abs(Val(brr(6)) - (Val(brr(24)) + Val(brr(25))) / 2) / Val(brr(6)) Else l = l - 1
Else
k = k - 1: l = l - 1
End If
Next
sp1 = sp1 / k: sp2 = sp2 / l
n = n + 1
ReDim Preserve crr(1 To 3, 1 To n)
crr(1, n) = brr(0)
crr(2, n) = sp1
crr(3, n) = sp2
fl = Dir
Loop
Sheet2.Range("a2:c" & Rows.Count).ClearContents
Sheet2.Range("a2").Resize(n, 3) = Application.Transpose(crr)
End Sub

复制代码

放眼TOT · 发表于 2012-12-20 15:21

yangyangzhifeng 发表于 2012-12-20 15:09
这下应该可以了

对啦！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！哇！！！太厉害啦！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！太感谢啦！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！

附子 · 发表于 2012-12-23 08:32

yangyangzhifeng 乐于助人不厌其烦的精神让我感动!!尽管对于vba一窍不通

		自动登录	找回密码
密码			免费注册

[求助] 如何用EXCEL批量处理TXT并将结果自动录入EXCEL