Сцепка значений ячеек по вариантам

[Тамара Кубарева]

В ячейке B3 файла Excel находится Xpath данной таблицы "assortment" и к результату применена замена переносов и табуляций на пробел. Без применения переносов и табуляций, было в файле, который в сообщении от 02.12.: http://prntscr.com/hi4omo
Вот ссылка на саму страницу товара: http://cool-kids.ru/product_info.php/info/p3569_Trusy-zhenskie-CONTE-Day-by-Day-RP-0002.html
Искажаться ничего не будет, вот так как есть так и получается.

[boa]

Если копипастить (во вложении), то можно результат обрабатывать в Excel
Ну а если парсить страницу, то это в коммерческие заказы...

[Тамара Кубарева]

Это и есть результат парсинга страницы, в ячейке B3 в частности результат Xpath таблицы "assortment". Необходимость есть теперь этот результат записать в виде последовательности записанных пар Цвет Размер в одной ячейке через "," как в той задаче, которая была в начале этой темы, и по которой Вы предложили пользовательскую функцию. Но там нужно было последовательно перечислить все размеры и цвета по вариантам для каждого цвета каждый размер. Теперь же не все пары цвет_размер могут быть в этом перечислении. Возможно ли на основании данных в ячейке B3 получить такую последовательность на основании анализа символов, присутствующих в этой ячейке, там два вида символов - есть или нет? 

[boa]

Здравствуйте, Тамара,
я то написал функцию под ваши условия, но она вряд ли кому-то пригодится из читателей форума ,
потому я и рекомендовал вам создать тему в "Заказы - платное решение задач по Excel", ведь это частный случай.

Код Выделить Развернуть


Option Explicit
Option Base 0

Public Function NewSplit(a As String) As String
Dim FirstArr$(), NewArr$()
Dim Str, x&, y&, i&, j&
a = Application.WorksheetFunction.Trim(a)
a = Replace(Replace(a, "<!-- -->", "Есть"), "<!-- Временно отсутствует --> ---", "Нет")
FirstArr = Split(a, " ")
For Each Str In FirstArr
    If IsNumeric(Str) Then y = y + 1
    If Not IsNumeric(Str) And y = 0 Then x = x + 1
Next
x = x - 1
ReDim NewArr(x, y)
For Each Str In FirstArr
    NewArr(i, j) = Str
    If i = x Then i = 0: j = j + 1 Else i = i + 1
Next
For i = 1 To x
    For j = 1 To y
    If NewArr(i, j) = "Есть" Then Str = Str & NewArr(i, 0) & " " & NewArr(0, j) & ","
    Next j
Next i
NewSplit = Mid(Str, 1, Len(Str) - 1)
End Function

[Тамара Кубарева]

boa , спасибо за прояснение. Саму суть вопроса и правду нужно искать и решать еще на выходе из парса, а не танцевать с бубном в экселе.