Excel VBA附加到文本框很慢

Question

我有一個用戶表單，它生成大量文本並將其放入文本框中。

我有以下功能，以文本的下一行追加到文本框：

Sub AddLineToSQL(sLine As String) 

    frmSQL.txtSQL.Value = frmSQL.txtSQL.Value & sLine & vbCr 

End Sub 

當添加幾百行文字它需要一段時間來處理（20秒）。

問題在於可能會添加超過一千行的文本。

我們有一箇舊的形式，做基本相同的事情，但我試圖創造一個更清潔的用戶體驗。舊的表單將文本寫入工作表，並且似乎比追加到文本框更快。

有沒有一種比上面我更有效的方式來添加文本到文本框？

我應該只是做舊的形式做和寫行到工作表？

感謝，

馬克

Answer 1

做一行到TextBox不附加線。而是將一個String與所有行連接起來，然後將該String設置爲TextBox值。

Sub test() 
Dim sTxtSQL As String 

For i = 1 To 5000 
    sTxtSQL = sTxtSQL & "This is row " & i & vbCrLf 
Next 

frmSQL.txtSQL.Value = sTxtSQL 
frmSQL.Show 
End Sub 

Answer 2

應的文字量是veeery大，那麼你可以使用這個類：

' Class: StringBuilder 
' from http://stackoverflow.com/questions/1070863/hidden-features-of-vba 
Option Explicit 

Private Const initialLength As Long = 32 

Private totalLength As Long ' Length of the buffer 
Private curLength As Long ' Length of the string value within the buffer 
Private buffer As String  ' The buffer 

Private Sub Class_Initialize() 
    ' We set the buffer up to it's initial size and the string value "" 
    totalLength = initialLength 
    buffer = Space(totalLength) 
    curLength = 0 
End Sub 

Public Sub Append(Text As String) 

    Dim incLen As Long ' The length that the value will be increased by 
    Dim newLen As Long ' The length of the value after being appended 
    incLen = Len(Text) 
    newLen = curLength + incLen 

    ' Will the new value fit in the remaining free space within the current buffer 
    If newLen <= totalLength Then 
    ' Buffer has room so just insert the new value 
    Mid(buffer, curLength + 1, incLen) = Text 
    Else 
    ' Buffer does not have enough room so 
    ' first calculate the new buffer size by doubling until its big enough 
    ' then build the new buffer 
    While totalLength < newLen 
     totalLength = totalLength + totalLength 
    Wend 
    buffer = Left(buffer, curLength) & Text & Space(totalLength - newLen) 
    End If 
    curLength = newLen 
End Sub 

Public Property Get Length() As Integer 
    Length = curLength 
End Property 

Public Property Get Text() As String 
    Text = Left(buffer, curLength) 
End Property 

Public Sub Clear() 
    totalLength = initialLength 
    buffer = Space(totalLength) 
    curLength = 0 
End Sub 

只是把它放在任何類模塊和「StringBuilder的」

那麼你可以給它命名按照Axel的測試方法進行類似的測試：

Sub test() 

Dim i As Long 
Dim sb As StringBuilder 
Dim sTxtSQL As String 

Dim timeCount As Long 

timeCount = Timer 

Set sb = New StringBuilder 
For i = 1 To 50000 
    sb.Append "This is row " & CStr(i) & vbCrLf 
Next i 
sTxtSQL = sb.Text 

MsgBox Timer - timeCount 

frmSQL.txtSQL.Value = sTxtSQL 
frmSQL.Show 

End Sub 

我的測試顯示顯着的時間縮短r「我」循環超過50k