[已解决]实验处理大量数据，需要导入excel，求大神做个宏

yifmee

我是做实验的，每次都要处理大量的数据，以前都是从数据文件里复制粘贴，处理起来很麻烦，有没有大神帮忙处理处理下，，压缩包里是13个文件，按照如下格式读取到Excel中工作簿1，读取后再另建一个工作簿2，将工作簿1中删除所有波长列复制到工作簿2中。

以下是需求的Excel格式
波长        0分钟        波长        1分钟        波长        2分钟        波长        3分钟        波长        4分钟        波长        10分钟        波长        15分钟        波长        20分钟        波长        25分钟        波长        30分钟        波长        40分钟        波长        50分钟        波长        60分钟


压缩包中数据我删除了很多，原始文件每个都有37600行，文件太大，我就删很多，就保留了500多行。
3张图片分别是数据文件，工作簿1的格式，工作簿2的格式
求大神帮忙，谢谢！！！

以下是实验数据格式
波长          *分钟
1.33390        -0.6083628
1.33459        -0.5385705
1.33527        1.4649545
1.33596        0.7310149
1.33664        1.4872652
1.33733        0.2499891
1.33802        -0.1355134
1.33870        -1.7010282
1.33939        1.0878104
1.34008        0.3060949
1.34076        1.4609897
1.34145        4.4273357
1.34214        5.4304523
1.34282        0.1537023
1.34351        0.4175962
1.34420        0.5257658
1.34488        0.7579889
1.34557        0.3438184
1.34626        0.8580491
1.34694        1.7833169
1.34763        1.3810167
1.34832        0.4468848
1.34900        -0.6867826
1.34969        1.3575714
1.35037        0.4330878
1.35106        -0.9014629
1.35175        0.2099570

最佳答案

月排行榜 / 总排行榜

grf1973

2017-5-23 14:20

1. Sub Macro1()
   
2.     Dim arr(100000, 1 To 100)
   
3.     Dim Filename$
   
4.     Filename = Dir(ThisWorkbook.Path & "\*.dpt")
   
5.     Do While Filename <> ""
   
6.         n = 0: k = k + 1
   
7.         Open ThisWorkbook.Path & "" & Filename For Input As #1
   
8.         arr(0, k) = Val(Mid(Filename, 7)) & "分钟"   '文件名换算到“分钟”
   
9.         Do While Not EOF(1)
   
10.             n = n + 1
    
11.             If namx < n Then nmax = n
    
12.             Line Input #1, x   '读入每行
    
13.             arr(n, k) = Split(x, vbTab)(1)   '只取每行后半部分
    
14.         Loop
    
15.         Close #1
    
16.         Filename = Dir
    
17.     Loop
    
18.     [a1].Resize(nmax, k) = arr
    
19. End Sub

复制代码

跳转到最佳答案楼层

QCW911

超级体力活

grf1973

1. Sub Macro1()
   
2.     Dim arr(100000, 1 To 100)
   
3.     Dim Filename$
   
4.     Filename = Dir(ThisWorkbook.Path & "\*.dpt")
   
5.     Do While Filename <> ""
   
6.         n = 0: k = k + 1
   
7.         Open ThisWorkbook.Path & "" & Filename For Input As #1
   
8.         arr(0, k) = Val(Mid(Filename, 7)) & "分钟"   '文件名换算到“分钟”
   
9.         Do While Not EOF(1)
   
10.             n = n + 1
    
11.             If namx < n Then nmax = n
    
12.             Line Input #1, x   '读入每行
    
13.             arr(n, k) = Split(x, vbTab)(1)   '只取每行后半部分
    
14.         Loop
    
15.         Close #1
    
16.         Filename = Dir
    
17.     Loop
    
18.     [a1].Resize(nmax, k) = arr
    
19. End Sub

复制代码

大灰狼1976

波长及时间和标题的0分钟、1分钟......有什么关系，我看你每两列数据都是一样的。
是不是把源数据整理后简单复制60次？

大灰狼1976

读取功能已完成，就看你需要怎么整理结果了。

grf1973

第11句可以放到第14句loop下面。

yifmee

大灰狼1976 发表于 2017-5-23 14:25
波长及时间和标题的0分钟、1分钟......有什么关系，我看你每两列数据都是一样的。
是不是把源数据整理后简 ...

不是的，我懒得把每一个都打开，就复制粘贴了，每一列测量值都是不一样的，波长相同

yifmee

grf1973 发表于 2017-5-23 14:29
第11句可以放到第14句loop下面。

谢谢你啊，想问问你第11行什么意思，其他的看你的注释还都看明白了

grf1973

11行是计算最终结果有多少行。

yifmee

grf1973 发表于 2017-5-23 16:24
11行是计算最终结果有多少行。

谢谢啊