| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
 跟大牛学C++学算法数据结构

已结贴   问题点数：5  回复次数：7
TXT文件转EXCEL文件如何加快速度？

得分:2
1s？

得分:0

得分:2

Sub txttoexcel2(txtfile As String, distancechar As String)
On Error GoTo l
Dim ttt As String
ttt = Timer
'建立excel对象
Dim xlapp As New Excel.Application
Dim xlwb As New Excel.Workbook
Dim xlst As New Excel.Worksheet
Set xlapp = CreateObject("excel.application")
xlwb.SaveAs FileName:=Left(txtfile, Len(txtfile) - 4) & ".xlsx"
Set xlst = xlwb.Worksheets(1)
'开始转换
Dim I As Integer, j As Integer, k As Integer, linenext As String, strb() As String
j = 1
Open txtfile For Input As #1
Do Until EOF(1)
Line Input #1, linenext
strb = Split(linenext, distancechar)
For I = 0 To UBound(strb)
If strb(I) <> "" Then
xlst.Cells(j, I + 1) = strb(I)
If j > 4 And j < 163 Then
If strb(I) = "1" Then xlst.Cells(j, I + 1).Interior.Color = RGB(0, 255, 0)
If strb(I) = "2" Then xlst.Cells(j, I + 1).Interior.Color = RGB(255, 0, 0)
If strb(I) = "3" Then xlst.Cells(j, I + 1).Interior.Color = RGB(0, 0, 255)
If strb(I) = "4" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 0, 0)
If strb(I) = "5" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 0, 200)
If strb(I) = "6" Then xlst.Cells(j, I + 1).Interior.Color = RGB(150, 50, 255)
If strb(I) = "7" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 100, 255)
If strb(I) = "8" Then xlst.Cells(j, I + 1).Interior.Color = RGB(255, 0, 200)
If strb(I) = "9" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 100, 0)
If (Asc(strb(I)) - 55) = "10" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 0, 50)
If (Asc(strb(I)) - 55) = "11" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 100, 100)
If (Asc(strb(I)) - 55) = "12" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 255, 50)
If (Asc(strb(I)) - 55) = "13" Then xlst.Cells(j, I + 1).Interior.Color = RGB(255, 50, 200)
If (Asc(strb(I)) - 55) = "14" Then xlst.Cells(j, I + 1).Interior.Color = RGB(0, 200, 0)
If (Asc(strb(I)) - 55) = "15" Then xlst.Cells(j, I + 1).Interior.Color = RGB(0, 255, 150)
If (Asc(strb(I)) - 55) = "16" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 150, 50)
If (Asc(strb(I)) - 55) = "17" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 50, 150)
If (Asc(strb(I)) - 55) = "18" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 50, 255)
If (Asc(strb(I)) - 55) = "19" Then xlst.Cells(j, I + 1).Interior.Color = RGB(0, 200, 200)
If (Asc(strb(I)) - 55) = "20" Then xlst.Cells(j, I + 1).Interior.Color = RGB(50, 0, 200)
If (Asc(strb(I)) - 55) = "21" Then xlst.Cells(j, I + 1).Interior.Color = RGB(150, 100, 150)
If (Asc(strb(I)) - 55) = "22" Then xlst.Cells(j, I + 1).Interior.Color = RGB(50, 50, 50)
If (Asc(strb(I)) - 55) = "23" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 100, 200)
If (Asc(strb(I)) - 55) = "24" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 150, 200)
If (Asc(strb(I)) - 55) = "25" Then xlst.Cells(j, I + 1).Interior.Color = RGB(50, 50, 150)
If (Asc(strb(I)) - 55) = "26" Then xlst.Cells(j, I + 1).Interior.Color = RGB(255, 0, 50)
If (Asc(strb(I)) - 55) = "27" Then xlst.Cells(j, I + 1).Interior.Color = RGB(50, 150, 255)
If (Asc(strb(I)) - 55) = "28" Then xlst.Cells(j, I + 1).Interior.Color = RGB(0, 200, 50)
If (Asc(strb(I)) - 55) = "29" Then xlst.Cells(j, I + 1).Interior.Color = RGB(100, 50, 0)
If (Asc(strb(I)) - 55) = "30" Then xlst.Cells(j, I + 1).Interior.Color = RGB(150, 255, 50)
If (Asc(strb(I)) - 55) = "31" Then xlst.Cells(j, I + 1).Interior.Color = RGB(200, 200, 100)
If (Asc(strb(I)) - 55) = "32" Then xlst.Cells(j, I + 1).Interior.Color = RGB(50, 0, 0)
'xlbook.Sheets(1).Rows(zzb).RowHeight = 10
'
Columns(Selection.Column).EntireColumn.AutoFit
'
Columns(Selection.Column).EntireColumn.AutoFit
End If
End If
Next
j = j + 1
Loop
Close #1
'结束，释放空间
xlst.Columns("A:FZ").AutoFit
xlwb.Save
xlwb.Close
xlapp.Quit
ttt = Timer - ttt
MsgBox "转换完毕, 用时 " & ttt & ""
'TimeDelay (0.001)
Exit Sub
l:
MsgBox "转换有错误, 用时 " & ttt & ""
End Sub

得分:0

得分:2
1、判断语句改为选择语句，可以在25秒完成
Select Case strb(I)
Case "1": xlst.Cells(j, I + 1).Interior.Color = RGB(0, 255, 0)
Case "2": xlst.Cells(j, I + 1).Interior.Color = RGB(255, 0, 0)
'''
end select
2、不做颜色处理2秒内完成，慢的过程主要是单元格颜色处理。
单元格复制可以用数组一次赋值，速度就可以控制在1-2秒
Set objRange = NewSheet.Range(NewSheet.Cells(1, 1), NewSheet.Cells(nRows, nColumns))
objRange.Value = CellsData1
【除非你直接写execl，大约1-2秒，再写一个vbs做颜色判断，这样打开execl，执行vbs就与程序无关了】
3、格式语句这么改，能减少些时间：xlapp.Workbooks(1).Worksheets(1).Cells.EntireColumn.AutoFit

得分:0

1、txt文件一次性读取
2、execl文件一次性赋值
3、不做颜色处理，不到1秒
4、涂色区域将最多的色，按照区间填色
5、对于其他颜色，按照单元格填色。

[此贴子已经被作者于2018-8-2 20:49编辑过]

得分:0
Wafer Map 不同的Wafer有不同的Bin Num设定

• 8
• 1/1页
• 1