萌新吐血求助——批量txt导入excel并选取特定数据分列排序

Roota

onlycxb 发表于 2018-9-14 06:18

您好，您的代码可以完美实现分列，但是时间那一列数据好像不太对，我观察了您的代码和褚老师的代码，是否需要在25行添加一个m=0，呢？萌新只能用这种笨办法了= 。=

onlycxb

Roota 发表于 2018-9-14 10:19
您好，您的代码可以完美实现分列，但是时间那一列数据好像不太对，我观察了您的代码和褚老师的代码，是否 ...

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.     Dim ColumnIndex As Integer, RowIndex As Integer, i As Integer, ss, mh, rq
   
5.     Dim arr, brr, Crr, mypath$, myname$, reg As New RegExp
   
6.     On Error Resume Next
   
7.     With reg
   
8.     End With
   
9.     mypath = ThisWorkbook.Path & ""
   
10.     myname = Dir(mypath & "*.txt")
    
11.     With Worksheets("sheet1")
    
12.         .Cells.Clear
    
13.     End With
    
14. 
    
15.     ColumnIndex = 1
    
16.     RowIndex = 1
    
17. 
    
18.     Do While myname <> ""
    
19. 
    
20.         reg.Global = False
    
21.         reg.Pattern = "^[a-zA-Z]+\s+(\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}:\d{2})\s+\|\s+[\d\.]+\s+\%\s+([\d\.]+)\s+C\s+$"
    
22. 
    
23.         Open mypath & myname For Input As #1
    
24.         arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
25.         Close #1
    
26.         ReDim brr(0 To UBound(arr) - 1, 1 To 2)
    
27. 
    
28.         ColumnIndex = ColumnIndex + 1
    
29.         For i = 0 To UBound(arr) - 1
    
30. 
    
31.             ss = Trim(arr(i))
    
32.             If Len(ss) > 0 Then
    
33.                 Set mh = reg.Execute(ss)
    
34.                 If mh.Count > 0 Then
    
35.                     brr(i, 1) = mh(0).SubMatches(0)
    
36.                     brr(i, 2) = Val(mh(0).SubMatches(1))
    
37.                 End If
    
38.             End If
    
39.         Next
    
40.       
    
41.         For i = 0 To UBound(brr)
    
42.             reg.Global = True
    
43.             reg.Pattern = "-00"
    
44.             brr(i, 1) = reg.Replace(brr(i, 1), "")
    
45.             If i = 0 Then rq = CDate(brr(0, 1))
    
46. 
    
47.             brr(i, 1) = Round((CDate(brr(i, 1)) - rq) * 24 * 60 * 60, 0)
    
48.         Next
    
49.         With Worksheets("sheet1")
    
50.             .Cells(RowIndex, 1) = Split(myname, ".")(0)
    
51.             .Cells(1, ColumnIndex) = Split(myname, ".")(0)
    
52.             .Cells(RowIndex + 1, 1).Resize(UBound(brr) + 1, 1) = Application.Index(brr, , 1)
    
53.             .Cells(RowIndex + 1, ColumnIndex).Resize(UBound(brr) + 1, 1) = Application.Index(brr, , 2)
    
54.             RowIndex = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    
55.         End With
    
56. 
    
57.         myname = Dir
    
58.     Loop
    
59. End Sub
    

复制代码

onlycxb

Roota 发表于 2018-9-14 10:19
您好，您的代码可以完美实现分列，但是时间那一列数据好像不太对，我观察了您的代码和褚老师的代码，是否 ...

901-温度数据.zip (392.95 KB, 下载次数: 11)

2018-9-14 19:55 上传

点击文件名下载附件

Roota

chxw68 发表于 2018-9-14 08:46
这个是麻醉药，止痛但不治病。

再次感谢，本来想私信感谢您的，但是新人等级太低，消息未发出，实在是万分感谢！上周末一直查到凌晨三点多，但是找到的代码都是有问题的，今天真的是太谢谢您了！我看了所有的代码，只有您用了正则表达式，这次真的是，太震惊了，代码畅通无阻！！！再次感谢，您拯救了我的时间，就是拯救了我的生命！

duquancai

Roota 发表于 2018-9-16 22:10
再次感谢，本来想私信感谢您的，但是新人等级太低，消息未发出，实在是万分感谢！上周末一直查到凌晨三点 ...

说得好夸张：“拯救了你的生命！”

chxw68

Roota 发表于 2018-9-16 22:10
再次感谢，本来想私信感谢您的，但是新人等级太低，消息未发出，实在是万分感谢！上周末一直查到凌晨三点 ...

就是太夸张了！小小代码不足挂齿。

Roota

onlycxb 发表于 2018-9-14 19:55

多谢大佬，等级太低，私信感谢无法发出，多谢您拯救了我的时间，我的生命  -.-

Roota

duquancai 发表于 2018-9-16 22:14
说得好夸张：“拯救了你的生命！”

不夸张呀，没有代码我就得一个一个txt导入，当时已经做了三十个了，手都麻了，回过神来想起或许可以用VBA，但是只学过一点C语言，帖子翻来覆去，代码只能看懂，完全不会写，摸索了一个晚上，熬夜加几个小时，这就是生命呀，如果再熬夜，搞不好要猝死

Roota

chxw68 发表于 2018-9-16 22:21
就是太夸张了！小小代码不足挂齿。

您坐标在北京吗?我请您吃海底捞！这些代码真是帮了我一个天大的忙

chxw68

Roota 发表于 2018-9-17 00:06
您坐标在北京吗?我请您吃海底捞！这些代码真是帮了我一个天大的忙

呵呵，我在大西北。