Excel VBA 追加到 TextBox 很慢

Question

我有一个生成大量文本并将其放入文本框的用户表单。

我有以下函数可以将下一行文本附加到文本框：

Sub AddLineToSQL(sLine As String)

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

End Sub

添加数百行文本时需要一段时间来处理（最多 20 秒）。

这样做的问题是有可能添加超过一千行的文本。

我们有一个旧的表单，基本上做同样的事情，但我正在努力创造更清晰的用户体验。旧的表单将文本写入工作表，它似乎比附加到文本框要快得多。

有没有比我上面的更有效的方法来将文本附加到文本框？

我应该像旧表格那样在工作表中写行吗？

谢谢，

马克

Answer 1

不要逐行附加到文本框。而是将一个字符串与所有行连接起来，然后将该字符串设置为 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

如果你的文字量很大，那么你可以使用这个 class:

' Class: StringBuilder
' from 
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

只需将它放在任何 Class 模块中并以 "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

我的测试显示 "i" 循环超过 50k

的时间显着减少

Excel VBA 追加到 TextBox 很慢

Excel VBA Append to TextBox is Slow

excel

performance

vba

textbox