附件中的11.txt为实验文件，软件可以把11.txt文件按我的要求转化成11.xlsx文件，但是就是速度太慢，要大概55秒左右的时间，如何加快呢？最好能在一秒左右。
请路过的大神和高手帮帮忙修改一下程序。谢谢！

1s？

其实就是越快越好，1s是理想值。

要想更快，可以批量写入数组，然后批量修改颜色，应该可以在10秒内完成（我电脑仅仅逐行读入文本也要3秒）。
去掉autofit或对代码修改如下，可以提高一倍速度：

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")
Set xlwb = xlapp.Workbooks.Add
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

刚实验通过批量写入数组，在不着色的情况下1至3秒可完成写入，由于数据的特殊性，相连色居多，应该也可以实现批量着色，估计10秒内可完成。
你的着色语句有问题，显然“If (Asc(strb(I)) - 55) = "10" ”是不可能成立的，因为数据不可能等于字符串。

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

看看是不是有惊喜。
真的实现了1-2秒。



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

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

Wafer Map 不同的Wafer有不同的Bin Num设定
一般HBIN比较少SBIN有时会到上千种
只分两种PASS FAIL应该会跑比较快吧