用VBA实现TXT导入然后设置

laoau138

用VBA实现TXT导入然后设置

老司机带带我

注意多新建一个工作表

1. Sub 数据读取()
   
2.     Dim myFso As New FileSystemObject
   
3.     Dim myTs As TextStream
   
4.     Dim str$, i As Integer, je As Double, m As Integer, x As Integer
   
5.     Set myTs = myFso.OpenTextFile(ThisWorkbook.Path & "\成绩单.txt")
   
6.     With Sheet2
   
7.         Do Until myTs.AtEndOfStream
   
8.             m = m + 1
   
9.             .Cells(m, 1).Resize(1, 4) = Split(myTs.ReadLine, Chr(9))
   
10.         Loop
    
11.         .Cells(1, 5).Resize(1, 3) = Array("总分", "平均分", "升留级")
    
12.         Sheet3.Cells(1, 1).Resize(1, 3) = Array("ID", "科目", "成绩")
    
13.         x = 1
    
14.         For i = 2 To m
    
15.             je = 0
    
16.             For j = 2 To 4
    
17.                 x = x + 1
    
18.                 Sheet3.Cells(x, 1) = .Cells(i, 1)
    
19.                 Sheet3.Cells(x, 2) = .Cells(1, j)
    
20.                 Sheet3.Cells(x, 3) = .Cells(i, j) * 1
    
21.                 .Cells(i, j) = .Cells(i, j) * 1
    
22.                 je = .Cells(i, j) + je
    
23.             Next
    
24.             .Cells(i, 5) = je
    
25.             .Cells(i, 6) = je / 3
    
26.             If je / 3 > 60 Then .Cells(i, 7) = "升级" Else .Cells(i, 7) = "留级"
    
27.         Next
    
28.     End With
    
29.     With Sheet3.Range("A1").CurrentRegion
    
30.         .Borders.LineStyle = True
    
31.         .Font.Size = 9
    
32.         .EntireRow.RowHeight = 14.25
    
33.     End With
    
34. End Sub
    

复制代码

laoau138

老司机带带我 发表于 2017-1-6 11:00
注意多新建一个工作表

老司机带带我   有一段时间见过你了

laoau138

这个确实是个高手

老司机带带我

laoau138 发表于 2017-1-6 13:37
老司机带带我   有一段时间见过你了

是没见过我了吧{:101:}

以后争取多来看看，没什么时间主要！

laoau138

老司机带带我 发表于 2017-1-6 13:48
是没见过我了吧

以后争取多来看看，没什么时间主要！

超过半年没有见过你

laoau138

老司机带带我 发表于 2017-1-6 11:00
注意多新建一个工作表

VBA蓝底单元格输入数字全排列   然后再容错

http://www.excelpx.com/thread-427027-1-1.html