txt批量导入不同sheet并进行数据处理 部分功能已自行搞定

wtoily

遇到很多需要批处理的测试文件，切需要作图和数据统计，再考虑能否批量化，目的如下，例子以及实现的效果将附件，请各位大侠帮忙：


1. 将所在文件夹的txt批量导入到一个Excel文件的不同sheet，sheet名称与txt文件名一致（备注：这里的txt有点特殊，第一行数据是一个日期，用双引号标注的，其余数据均已空格作为断列的参数）；
"2017-05-20 at 18:20"
Date Time) A B C D E F G
2017-05-20 18:20:08 407.76 2.10 -15.65 51.15 86.78 0.0731 0.0168
2. 数据处理，对所有sheet添加一列（例子中的J列），内容为从1到n的逐1增加的序列，n与数据的行数一致；
3. 作图，对所有数据做以J列数据（J3开始为）横坐标，C列数据（C3开始）为纵坐标的散点图，图名称为A1的数据；
4. 简单计算（例子中xls文件绿色部分），使L2,M2,N2,O2,P2单元格中内容依次为ID，Day，time，Slop；使L3,M3,N3,O3,P3依次为L3：=RIGHT(CELL("filename"),LEN(CELL("filename"))-FIND("]",CELL("filename")))
M3:=A$3
N3:=B$3
O3:=(P3^0.5)*STDEV(C$3:C$10000)/STDEV($J$3:$J$10000)
P3:=(CORREL(J$3:J$10005,$C$3:$C$10005)^2)

非常感谢。
11月1日更新：已搞定生成sheet的代码，以及对单个表格生成序号的代码（求批处理的方法），求生成散点图及获取相关系数及相关性的代码。

wtoily

以上不一定要一个代码完成，几个代码分步完成也可以的！

wtoily

第一步，批量生成sheet表格已经完美解决，代码如下：

1. Sub addSht()
   
2.     Dim Fso As Object, Fl As Object
   
3.     Dim oClp As Object, Str$, i%, m%
   
4.    
   
5.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
6.     Set oClp = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
   
7.     For Each Fl In Fso.getfolder(ThisWorkbook.Path & "/").Files
   
8.         If Fl.Name Like "*.txt" Then
   
9.             i = i + 1
   
10.             If i > Sheets.Count Then Sheets.Add after:=Sheets(Sheets.Count)
    
11.             Sheets(i).Name = Replace(Fso.getfilename(Fl), ".txt", "")
    
12.             Open Fl For Input As #1
    
13.             Str = StrConv(InputB(LOF(1), 1), vbUnicode): Reset
    
14.             For m = 1 To 10
    
15.                 Str = Replace(Str, "  ", " ")
    
16.             Next
    
17.             oClp.settext Replace(Str, " ", vbTab)
    
18.             oClp.putinclipboard
    
19.             Sheets(i).Paste Sheets(i).[A1]
    
20.             oClp.Clear
    
21.         End If
    
22.     Next
    
23.    
    
24.     Set oClp = Nothing
    
25. End Sub
    

复制代码

求添加序列以及画图的代码，灰常感谢

wtoily

第二部 单个表格在制定列生成序列号已经搞定，但是不知道如何批量对所有表格进行批处理。代码如下：

1. Sub mysub()
   
2. Dim i As Integer, x As Integer
   
3. x = 0
   
4. For i = 3 To [b65536].End(xlUp).row
   
5. If Range("a" & i) <> "" Then
   
6. Range("j" & i) = x + 1
   
7. x = x + 1
   
8. End If
   
9. Next i
   
10. End Sub
    

复制代码

wtoily

经过2天自学，总算实现全部功能了！
但发现txt转为sheet文件过程中容易出错，貌似是通病，不知道如何优化。