| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
大量收QQ微信精准粉/交友粉,非诚勿扰千里之行 始于足下
共有 471 人关注过本帖
标题:TXT文件转EXCEL文件如何加快速度?
只看楼主 加入收藏
ictest
Rank: 2
等 级:论坛游民
帖 子:225
专家分:77
注 册:2010-2-17
结帖率:75%
  已结贴   问题点数:5  回复次数:7   
TXT文件转EXCEL文件如何加快速度?
附件中的11.txt为实验文件,软件可以把11.txt文件按我的要求转化成11.xlsx文件,但是就是速度太慢,要大概55秒左右的时间,如何加快呢?最好能在一秒左右。
请路过的大神和高手帮帮忙修改一下程序。谢谢!
附件: 您没有浏览附件的权限,请 登录注册
2018-08-01 17:28
Artless
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:103
帖 子:4211
专家分:28884
注 册:2009-4-8
  得分:2 
1s?

无知
2018-08-02 01:39
ictest
Rank: 2
等 级:论坛游民
帖 子:225
专家分:77
注 册:2010-2-17
  得分:0 
回复 2楼 Artless
其实就是越快越好,1s是理想值。
2018-08-02 06:02
wmf2014
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:153
帖 子:1706
专家分:9520
注 册:2014-12-6
  得分:2 
要想更快,可以批量写入数组,然后批量修改颜色,应该可以在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

能编个毛线衣吗?
2018-08-02 10:34
wmf2014
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:153
帖 子:1706
专家分:9520
注 册:2014-12-6
  得分:0 
刚实验通过批量写入数组,在不着色的情况下1至3秒可完成写入,由于数据的特殊性,相连色居多,应该也可以实现批量着色,估计10秒内可完成。
你的着色语句有问题,显然“If (Asc(strb(I)) - 55) = "10" ”是不可能成立的,因为数据不可能等于字符串。

能编个毛线衣吗?
2018-08-02 16:45
wds1
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:24
帖 子:254
专家分:1401
注 册:2016-3-10
  得分: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

2018-08-02 17:35
wds1
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:24
帖 子:254
专家分:1401
注 册:2016-3-10
  得分:0 


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



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

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

附件: 您没有浏览附件的权限,请 登录注册
2018-08-02 20:23
yz1025
Rank: 8Rank: 8
等 级:蝙蝠侠
威 望:6
帖 子:422
专家分:868
注 册:2012-10-26
  得分:0 
Wafer Map 不同的Wafer有不同的Bin Num设定
一般HBIN比较少SBIN有时会到上千种
只分两种PASS FAIL应该会跑比较快吧

不要投我
2018-08-07 18:06







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.025549 second(s), 8 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved