Новости:

Прикрепить к сообщению можно только файлы xls, gif, jpg, rar, zip,7z, bas, frm, cls, doc размером до 150 Кб.

Главное меню

Поиск блока символов в массиве ч/з UDF

Автор mick-77, 22.09.2014, 20:11

« назад - далее »

mick-77

Здравствуйте уважаемые форумчане!
Позвольте обратиться за советом.
Благодаря помощи добрых людей (спасибо Александру «ikki»), есть в наличии UDF .
Функция помогает находить вертикальные блоки символов в массиве: указывается номер строки и она возвращает номер столбца, где заданный блок символов «сидит» в буквальном смысле сверху на строке.

Функция работает как часы, «вылавливая» блоки одинакового содержания, например, «ДДДДДД» или «НННН» (высота задаётся отдельно, в зависимости от кол-ва символов).
Однако, когда возникла необходимость поискать блоки разного наполнения – «ДДННН», «НННДДД», «вуНННННН», «ДДуНННН» - то к сожалению, функция отказалась выручать...
Думал, переменной (s) непосредственно указывать «состав» символов, чтобы Split создавал искомый массив. Всё равно не работает. Чувствую, что загвоздка находится где-то в циклах с присвоением значений переменным.
Честно скажу, что механизм этой функции до конца не понимаю – не могу «допетрить», где нужно «подкрутить»... Пусть даже переменную высоты блока (х) придётся задавать отдельно для каждого набора блока, лишь бы функция «научилась» находить блоки с разным составом символов.

Если это не сложная задачка, посоветуйте, пожалуйста, что можно отредактировать в коде?
Благодарю за внимание!

Function f(r As Range, n&, Optional x = 7, Optional s = "Д;Н")
  Dim a(), b&(), j&, k&, jj&, xx, ss$, ff As Boolean
  If x > r.Rows.Count Or x > n Then f = CVErr(xlErrValue): Exit Function
  a = r.Rows(n - x).Resize(x).Value
 
  xx = Split(s, ";")
  For jj = 0 To UBound(xx)
    ss = ";" & xx(jj): xx(jj) = ""
    For j = 1 To x: xx(jj) = xx(jj) & ss: Next
  Next
   
  ReDim b(1 To Application.Caller.Columns.Count): j = 1: k = 0
  Do While j <= UBound(a, 2) And k < UBound(b)
    ss = "": ff = False
    For jj = 1 To x: ss = ss & ";" & a(jj, j): Next
    For jj = 0 To UBound(xx)
      If ss = xx(jj) Then ff = True: Exit For
    Next
    If ff Then k = k + 1: b(k) = j
    j = j + 1
  Loop
  f = b
End Function

doober


mick-77

Решение нашёл doober (на планете), тему можно закрывать.

Для doober отвечу там же на планете.

Выражаю благодарность всем, кто интересовался данной темой! Спасибо за внимание!
Ещё раз прошу прощения, что сделал "кросс" и не предупредил вас!