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://*.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