麻辣家族討論版版's Archiver

dou10801 發表於 2021-11-4 10:40

匯入txt檔能不能再優化.

請教各位前輩,匯入txt檔能不能再優化.

准提部林 發表於 2021-11-6 12:27

文字檔資料不多, 原程式已可快速處理,
哪個地方要優化?
說明需求, 並做個範例!!

dou10801 發表於 2021-11-6 14:05

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117611&ptid=23468]2#[/url] [i]准提部林[/i] [/b]
抱歉,沒說清楚原txt檔有3千-5千筆,匯入時速度Ok, 但每頁有19行,須在每頁第固定第3行及第17行更改行高時,速度就會變慢,是否其他方法,感恩。

准提部林 發表於 2021-11-6 17:44

Sub 匯入txt()
Dim Arr, Brr, FS$, xLine, xR As Range
t = Timer
ReDim Arr(1 To 6000, 0): Brr = Arr
Application.ScreenUpdating = False
FS = ThisWorkbook.Path & "\sun03.txt"
Open FS For Input As #1
    Do While Not EOF(1)
       Line Input #1, xLine
       xLine = Replace(xLine, "  ", " ")
       i = i + 1
       Arr(i, 0) = xLine
        If i > 1 And i Mod 19 = 1 Then Rows(i).PageBreak = xlPageBreakManual
         '[color=blue]↑逐一設定分頁線, 速度一定會慢, 可取消這行, 直接將列印的"下邊界"設為13公分[/color]  
        If i Mod 19 = 3 Then Brr(i, 0) = 1
        If i Mod 19 = 17 Then Brr(i, 0) = "A"
    Loop
Close #1
'--------------------------------
With Range("A1").Resize(i)
     .Value = Brr
     On Error Resume Next
     .SpecialCells(xlCellTypeConstants, 1).RowHeight = 21 '快速選取-常數-數字
     .SpecialCells(xlCellTypeConstants, 2).RowHeight = 30 '快速選取-常數-文字
     On Error GoTo 0
     .Value = Arr
End With
MsgBox Timer - t
End Sub

dou10801 發表於 2021-11-6 18:17

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117615&ptid=23468]4#[/url] [i]准提部林[/i] [/b]
超神解法,收下慢慢學習,感激不盡。

頁: [1]

麻辣家族討論版版為 麻辣學園 網站成員  由 昱得資訊工作室 © Since 1993 所提供