TextToColumns - умеет определять кол-во будущих columns?

[rdva]

Предположим, есть три столбца. В кажой ячеке которых содержится от одного до четырех значений (случайным образом) , разделенных ";". Нужно макросом разложить все это дело по столбцам, в соответсвии с разделителем. Соответственно, каждый столбец будет разбит на некоторое кол-во столбцов. Можно как-то определить это количество? В хелпе по TextToColumns ничего похожего не нашел.

Пока вижу только один алгоритм:
1. Зная, что каждый столбец будет разбит макимум на 4 (включая один уже существующий), вставляем справа каждого столбца по 3 новых столбца.
2.Делаем TextToColimns.
3.Если в столбце все ячейки пустые - удаляем этот столбец.

Что скажет уважаемый All?

[uhm]

Можно так. Навскидку, оптимальней сначала посчитать количество разделителей в ячейках, и вычислить максимум. Просто из метода TextToColumns ты такую информацию сразу не вытащишь.

[Чудовище под кроватью]

Предположим, есть три столбца. В кажой ячеке которых содержится от одного до четырех значений (случайным образом) , разделенных ";". Нужно макросом разложить все это дело по столбцам, в соответсвии с разделителем. Соответственно, каждый столбец будет разбит на некоторое кол-во столбцов. Можно как-то определить это количество? В хелпе по TextToColumns ничего похожего не нашел.

Посчитать маскимальное количество, думаю, можно и без TextToColumns. - Сначала пытаешься найти ячейки с содержимым Like "*;*;*;*", если таковые есть, значит, столбцов будет максимум 4. Иначе ищешь ячейки с содержимым Like "*;*;*" и т.д.
Делается, если не ошибаюсь, через Select Case.

[KL]

еще варианты:

Код: Выделить всё

Sub test1()
    Dim x
    x = Evaluate("MATCH(TRUE,COUNTIF(A:A,{""*;*;*;*"",""*;*;*"",""*;*""})>0,0)")
    If IsNumeric(x) Then [b:b].Resize(, 4 - x).Insert
End Sub

Sub test2()
    Dim x As Integer
    Select Case False
    Case [a:a].Find("*;*;*;*", [a1], xlValues) Is Nothing: x = 3
    Case [a:a].Find("*;*;*", [a1], xlValues) Is Nothing: x = 2
    Case [a:a].Find("*;*", [a1], xlValues) Is Nothing: x = 1
    End Select
    If x Then [b:b].Resize(, x).Insert
End Sub