将文本文件转为Excel文件

APPLE123

gwjkkkkk 发表于 2023-2-10 23:40
请楼主参考附件。。。

谢谢老师！麻烦老师了！

gwjkkkkk

APPLE123 发表于 2023-2-11 11:02
谢谢老师！麻烦老师了！

你这个本来有规律的数据，写入还是比较方便，但字段一旦不确定，难度还是成倍上升的，代码给你写了注释，请参考。。。

fzxba

1. Sub test0()
   
2.   Dim ar() As String, br, cr
   
3.   Dim i As Long, j As Integer, k As Integer  
   
4.   Dim r As Long, c As Integer, s As String
   
5.   Open ThisWorkbook.Path & "\测试文本2.txt" For Input As #1
   
6.   br = Split(Trim(StrConv(InputB(LOF(1), #1), vbUnicode)), "就职")
   
7.   Close #1
   
8.   ReDim ar(UBound(br), 8)
   
9.   For i = 0 To UBound(br)
   
10.     s = Trim(br(i))
    
11.     If Len(s) Then
    
12.       cr = Split(s, vbNewLine)
    
13.       k = 1 + IsNumeric(cr(5))
    
14.       For j = 1 To UBound(cr)
    
15.         If j < 5 Then ar(r, j) = cr(j) Else ar(r, j + k) = cr(j)
    
16.       Next
    
17.       r = r + 1
    
18.       ar(r - 1, 0) = r
    
19.       If j > c Then c = j
    
20.     End If
    
21.   Next
    
22.   ActiveSheet.UsedRange.Offset(2).ClearContents
    
23.   Range("A3").Resize(r, c) = ar
    
24.   Beep
    
25. End Sub

复制代码

APPLE123

fzxba 发表于 2023-2-11 19:23

谢谢老师！代码很简洁，却能达到要求的效果，太棒了。
可是我不太理解，可否帮忙注释一下，便于学习消化。谢谢！

gwjkkkkk

fzxba 发表于 2023-2-11 19:23

又学到了思路，够简洁。。。

fzxba

APPLE123 发表于 2023-2-12 11:53
谢谢老师！代码很简洁，却能达到要求的效果，太棒了。
可是我不太理解，可否帮忙注释一下，便于学习消化 ...