Ускорить обработку строки, с использованием InStr

[motorway]

Привет всем.
Мне нужно ускорить обработку текстовой строки, я сделал один вариант кода, но он долго работает, если строка около 200 кБ. Поэтому надо переделать код без использования Split, а использовать InStr и Mid, т.е. посимвольную обработку (что может помочь).

Строка имеет вид:

Лист1~B2|value`C2|value`...`:::Лист2~B2|value`C2|value`:::Лист3~B2|value`C2|value`

Т.е., сначала идет название листа, далее разделитель ~, далее название ячейки, потом разделитель |, далее значение, потом разделитель ` и данные для следующей ячейки.
И так далее до разделителя между листами ":::". Если лист один, то такого разделителя не будет, соответственно.
Код обрабатывает эту строку и помещает результат value в соотв. ячейку на листе, например для ячейки B2 на Листе1 будет значение value и т.п. для других ячеек.

Сейчас у меня такой код:

List = Split(stack, ":::")
For Each l In List
Sheet = Split(l, "~")
sheetname = Sheet(0)
znach = Sheet(1)
zn = Split(znach, "`")
Set shname = Worksheets(sheetname)
For Each Z In zn
If (Len(Z)) Then
Data = Split(Z, "|")
yach = Data(0)
Value = Data(1)
shname.Range(yach).Value = Value
End If
Next Z
Next l

Кто может помочь переделать это с использованием InStr и Mid?

[SAS888]

код без использования Split, а использовать InStr и Mid, т.е. посимвольную обработку (что может помочь).

Уверяю Вас, что это будет еще медленнее. В данном случае, основное время затрачивается не на получение имен листов и адресов ячеек, а на обращение к ячейкам рабочих листов Excel.
Ну, и по коду: с какой целью выполняется проверка If (Len(Z)) Then ? Что, 2 разделителя значений подряд, это возможный вариант? Также, можно убрать лишние присваивания значений переменным. Т.е., примерно так:

List = Split(stack, ":::")
For Each l In List
    Sheet = Split(l, "~")
    zn = Split(Sheet(1), "`")
    Set shname = Sheets(Sheet(0))
    For Each Z In zn
    Data = Split(Z, "|")
        shname.Range(Data(0)) = Data(1)
    Next
Next

P.S. Если не секрет, прикрепите Вашу строку в 200 кБ, а мы посмотрим, как можно ускорить процесс обработки.

[motorway]

Насколько я помню, эту проверку я сделал, т.к. иногда возникали ошибки, если строка имела определенный вид (пустое значение или что-то подобное).
Пример строки прикрепил.
Да, вот в случае исп. вашего кода выдает ошибку Subscript out of range - видимо, там остается пустая строка.

[SAS888]

пустое значение или что-то подобное

Да, действительно. Присутствуют непечатные символы. Проверка нужна.
Ваш код, практически, оптимален. Но, как я уже говорил, основное время макрос затрачивает на непосредственное обращение к ячейкам рабочего листа Excel. Поэтому, целесообразно лишний раз этого не делать. Тем более, что в исходной строке присутствует очень большое количество пустых значений. Существенно ускорить работу макроса можно, вставив такую проверку. Также, лучше запретить обновление экрана, т.к. при вставке данных на активный лист Excel будет отображать (прорисовывать) этот процесс.
Попробуйте выполнить макрос с этими добавлениями. Сравните время выполнения. С Вашего позволения, добавил процедуру выбора txt-файла для обработки.

Sub Main()
    Dim shname As Worksheet, f As String, List, l, zn, z, Sheet, Data, fso
    Application.ScreenUpdating = False: Set fso = CreateObject("Scripting.FileSystemObject")
    f = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If f = "False" Then Exit Sub
    List = Split(fso.OpenTextFile(f, 1).ReadAll, ":::")
    For Each l In List
        Sheet = Split(l, "~"): zn = Split(Sheet(1), "`"): Set shname = Sheets(Sheet(0))
        For Each z In zn
            If Application.Clean(z) <> "" Then
                Data = Split(z, "|")
                If Data(1) <> "" Then shname.Range(Data(0)) = Data(1)
    End If: Next: Next
End Sub

Пример во вложении. Еще раз повторю, что время выполнения добавленной проверки (If Data(1) <> "" Then...) существенно меньше, нежели вставка пустого значения в ячейку. Поэтому, при большом объеме пустых значений, получим ощутимый выигрыш по времени.

[motorway]

Код скоро попробую. В данном случае строка была такой, но может быть и совершенно другой, где значений много, а пустых мало. Но в любом случае, если значение пустое, то его надо присвоить ячейке - там же может быть непустое.
Что-то мне кажется, что ускорить не получится просто так. Нужно менять сам принцип. Что-нибудь вроде вставки из csv файла.

[doober]

Я думаю уважаемый SAS888 не обидится за то,что я взял его макрос за основу,но добавил свою обработку данных.Работает практически мнговенно.Но справедлив по столбец Z включительно
Если диапазон больше,надо немного доработать получение адреса самого последнего столбца

Sub Main()
    Dim shname As Worksheet, f As String, List, l, zn, z, Sheet, Data, fso
    Dim aa, bb, dat, Star
     Dim sl, ssl As String
      Dim nah, kond, end_D, dp, kk, kl, n As Long
    Application.ScreenUpdating = False: Set fso = CreateObject("Scripting.FileSystemObject")
    f = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If f = "False" Then Exit Sub
    List = Split(fso.OpenTextFile(f, 1).ReadAll, ":::")
    For Each l In List
        Sheet = Split(l, "~"):
        zn = Split(Sheet(1), "`"):
        Set shname = Sheets(Sheet(0))
        aa = zn(0): Star = Split(aa, "|"): bb = zn(UBound(zn) - 1)
         sl = Mid(aa, 1, 1): ssl = Mid(bb, 1, 1)
           nah = Asc(sl) - 64: kond = Asc(ssl) - 64
          end_D = Split(bb, "|"): dp = kond - nah + 1: kk = (UBound(zn)) / dp
          ReDim rezu(1 To kk, 1 To dp)
          kl = 0
        For n = 0 To (UBound(zn)) / dp - 1
           For m = 1 To dp
            dat = Split(zn(kl), "|")
              rezu(n + 1, m) = dat(1)
            kl = kl + 1
       Next: Next
    shname.Range(Star(0) & ":" & end_D(0)) = rezu
   Next
End Sub

[SAS888]

О какой обиде Вы говорите? Мы делаем общее дело. Но...
1. Ваш вариант ограничен столбцом из 1-й буквы "A:Z" (оговорено).
2. Ваш вариант будет корректно работать только тогда, когда в строке для обработки адреса ячеек отсортированы по возрастанию?
3. При вставке значений массива на рабочий лист (обязательное условие - непрерывный диапазон), исходные значения в ячейках, адреса которых отсутствуют в текстовой строке будут утеряны.

Всвязи с этим, вопросы автору темы:
1. Какой максимально возможный диапазон рабочего листа может быть использован (макс. № строки и столбца)?
2. Могут ли адреса ячеек в строке следовать не по порядку, либо не подряд? Например:
"...Лист1~B2|11`M123|16`C2|22.. ."
или
"...Лист1~B2|11`E2|16`H2|22..."
Т.е. есть ли какая-либо закономерность в очереди адресов ячеек текстовой строки для каждого листа?
3. Данные из текстовой строки вставляются на пустой лист? Т.е. можно ли очищать уже имеющиеся на листе значения ячеек, отсутствующих в текстовой строке?

[alex77755]

Попадалось заметка, что значительная потеря времени идёт при обращении к Range. Уберите из процедуры так же и названия листов - тоже тормозят.
Бастрее, говорят, будет обращение:
Лист1.Cells(5,2)

[doober]

ТО SAS888 Полностью с Вами согласен,
чтобы выработать оптимальный алгоритм,
надо полностью знать условия и принцип организации обмена информацией.Программно всегда решить можно любую практически,задачу

[alvazor]

Да, спецы правы, в таком варианте все тормозит запись на лист!
Несколько изменил макрос - вначале формирую полный массив данных, потом уже запись его на лист, процесс разделил месиджами. Все хорошо видно (заодно и сбои с пустыми данными убрал)