[已解决]将txt中特定字符行置顶

ls

将txt中特定字符行置顶(移到第一行)

特定字符:    (ok)

最佳答案

月排行榜 / 总排行榜

顺⑦.zì繎。

2014-4-19 09:55

1. Sub Macro1()
   
2. Application.DisplayAlerts = False '关闭报警
   
3. Dim arr(), brr, string1 As String, i, c, n
   
4. Open "C:\Users\EXCEL精英培训网\Desktop\复件待处理.txt" For Input As #1   '打开文本文件路径自己填
   
5. string1 = StrConv(InputB(LOF(1), 1), vbUnicode)
   
6. brr = Split(string1, Chr(10))
   
7. 
   
8. For i = 0 To UBound(brr)
   
9.     For j = i + 1 To UBound(brr)
   
10.        If brr(j) Like "*ok*" And Not brr(j - 1) Like "*ok*" Then
    
11.              tx = brr(i)
    
12.              brr(i) = brr(j)
    
13.              brr(j) = tx
    
14.        End If
    
15.     Next
    
16. Next
    
17. Close #1
    
18. Open "C:\Users\EXCEL精英培训网\Desktop\复件待处理.txt" For Output As #1 '打开文本文件路径自己填
    
19.      For Each c In brr
    
20.          Print #1, c
    
21.      Next
    
22. Close #1
    
23. Application.DisplayAlerts = True
    
24. End Sub

复制代码

跳转到最佳答案楼层

顺⑦.zì繎。

1. Sub Macro1()
   
2. Application.DisplayAlerts = False '关闭报警
   
3. Dim arr(), brr, string1 As String, i, c, n
   
4. Open "C:\Users\EXCEL精英培训网\Desktop\复件待处理.txt" For Input As #1   '打开文本文件路径自己填
   
5. string1 = StrConv(InputB(LOF(1), 1), vbUnicode)
   
6. brr = Split(string1, Chr(10))
   
7. ReDim arr(0 To UBound(brr))
   
8. For i = 0 To UBound(brr)
   
9.        If brr(i) Like "*ok*" Then
   
10.           arr(0) = arr(0) & brr(i)
    
11.        Else
    
12.           n = n + 1
    
13.           arr(n) = brr(i)
    
14.        End If
    
15. Next
    
16. Close #1
    
17. Open "C:\Users\EXCEL精英培训网\Desktop\复件待处理.txt" For Output As #1 '打开文本文件路径自己填
    
18.      For Each c In arr
    
19.          Print #1, c
    
20.      Next
    
21. Close #1
    
22. Application.DisplayAlerts = True
    
23. End Sub
    

复制代码

这意思，我也是初学啊

ls

顺⑦.zì繎。 发表于 2014-4-19 05:22
这意思，我也是初学啊

能不能一个ok一行呢,版主

顺⑦.zì繎。

ls 发表于 2014-4-19 09:30
能不能一个ok一行呢,版主

能啊。。。 最初我也是这么想的。。。但是后来我发现 那样写的话 跟你附件的原来的结果是一模一样啊。。就以为你是要这结果

顺⑦.zì繎。

1. Sub Macro1()
   
2. Application.DisplayAlerts = False '关闭报警
   
3. Dim arr(), brr, string1 As String, i, c, n
   
4. Open "C:\Users\EXCEL精英培训网\Desktop\复件待处理.txt" For Input As #1   '打开文本文件路径自己填
   
5. string1 = StrConv(InputB(LOF(1), 1), vbUnicode)
   
6. brr = Split(string1, Chr(10))
   
7. 
   
8. For i = 0 To UBound(brr)
   
9.     For j = i + 1 To UBound(brr)
   
10.        If brr(j) Like "*ok*" And Not brr(j - 1) Like "*ok*" Then
    
11.              tx = brr(i)
    
12.              brr(i) = brr(j)
    
13.              brr(j) = tx
    
14.        End If
    
15.     Next
    
16. Next
    
17. Close #1
    
18. Open "C:\Users\EXCEL精英培训网\Desktop\复件待处理.txt" For Output As #1 '打开文本文件路径自己填
    
19.      For Each c In brr
    
20.          Print #1, c
    
21.      Next
    
22. Close #1
    
23. Application.DisplayAlerts = True
    
24. End Sub

复制代码