[已解决]有关于提取整理特殊文本内容的求助

grf1973

按你规则。

1. Sub Macro1()
   
2.     Dim arr(1 To 1000, 1 To 2), tmp
   
3.     Open ThisWorkbook.Path & "\提取特殊文本内容.txt" For Input As #1
   
4.     Do While Not EOF(1)
   
5.         Line Input #1, tmp
   
6.         tmp = Trim(tmp)
   
7.         If InStr(tmp, "-") > 0 Then
   
8.             n = n + 1
   
9.             arr(n, 1) = tmp '读入每行
   
10.             k = 0
    
11.         Else
    
12.             k = k + 1
    
13.             If k <= 5 Then arr(n, 2) = arr(n, 2) & tmp
    
14.         End If
    
15.     Loop
    
16.     Close #1
    
17.     If n > 0 Then Sheet1.[a1].Resize(n, 2) = arr
    
18. End Sub

复制代码

qiuzhuvba

感谢grf1973 老师的再次解答