Excel VBA Append для TextBox медленный
У меня есть пользовательская форма, которая генерирует большой объем текста и помещает его в текстовое поле.
У меня есть следующая функция, чтобы добавить следующую строку текста в текстовое поле:
Sub AddLineToSQL(sLine As String) frmSQL.txtSQL.Value = frmSQL.txtSQL.Value & sLine & vbCr End Sub При добавлении нескольких сотен строк текста требуется время для обработки (до 20 секунд).
- Как установить текстовое поле в пользовательской форме для дробного значения?
- Сохранить значение текстового поля, VBA, Excel
- Excel VBA; UserForm, запуск одного фрагмента кода для разных значений TextBox
- Код устранения неполадок для макросов и текстовых полей
- Как сделать текстовое поле ActiveX только для чтения, но прокручиваемым в Excel 2013?
Проблема заключается в том, что есть возможность добавить более тысячи строк текста.
У нас есть старая форма, которая делает в основном одно и то же, но я пытаюсь создать более чистый пользовательский интерфейс. старая форма написала текст на листе, и, похоже, он работает намного быстрее, чем добавление в текстовое поле.
Есть ли более эффективный способ добавления текста в текстовое поле, чем то, что у меня выше?
должен ли я просто делать то, что делал старая форма, и писать строки на листе?
Благодаря,
отметка
- Создание текстового поля для запуска формулы VBA
- Добавление текста в текстовое поле
- VBA - Как я могу дать код ошибки на основе суммы моих значений текстового поля в форме пользователя?
- Вставить из excel в текстовое поле
- Скопировать и вставить содержимое из текстового поля в диапазон ячеек рабочего листа?
- Как изменить цвет фона текстового поля с помощью кнопки
- Копирование / управление форматированным текстом в текстовых блоках в Excel 2013 с использованием VBA
- Ячейка, связанная с текстовым полем ActiveX, возвращающая текст вместо номера
Не добавляйте строки в строку в 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
если ваше количество текста будет большим, тогда вы можете использовать этот класс:
' 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»,
то вы можете протестировать его так же, как в ответе Акселя:
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» циклов более 50 тыс.