Комбинаторика. Как разделить текстовую строку на минимальное количество блоков по условию, Как сформировать диапазон из очень длинной текстовой строки адресов
Доброго времени суток, Планетяне! Прошу помощи в алгоритмизации, комбинаторике и программировании в целом. Не смотрите, что как ТЗ - просто по полочкам старался разложить и, чтобы "многабукаф" не получилось
Дано: 1. одномерный массив arr из N = Ubound(arr)+1 элементов (количество адресов ячеек) 2. текстовая строка (txt = Join(arr, ",")) длиной L символов
Условия: 1. длина строки каждого адреса может быть от 2 (например "B6") до 10 (например "ABC1000000") символов 2. в блоке не может быть более 255 символов, при этом адреса не могут "разрываться", то есть каждый блок начинается с буквы и заканчивается цифрой
Вопрос: как будет выглядеть код VBA, чтобы получить минимальное количество блоков?
Откуда задача: в этой своей теме не мог понять, почему не работает макрос. Пытался сформировать диапазон из очень длинной текстовой строки (txt = очень много адресов ячеек через запятую, Range(txt).Select). Покопавшись в интернете, узнал тут, что длина строки не может быть больше 255 символов — так родилась эта задача.
Связывать название темы с реальной задачей не хотел, т.к. этот приём много где может пригодится. Альтернативным методам решения задачи (реальной) также буду рад. Хотел разместить в понедельник, т.к. дома сейчас даже xl нет, но подумал, что кому-то может быть интересно в воскресенье подумать
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, Приветствую. Правильно ли я понял задачу. Вы собираете адреса в массив, сумма символов (адресов) массива (блока) не должна превышать 255 символов. Вопрос: Если длина символов блока превышает 255, то мы создаём новый массив данных (блок)?
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок. А в том, чтобы писать программы, работающие при любом количестве ошибок.
Jack Famous, Иными словами, из произвольного набора чисел c величинами от A до N нужно сформировать наименьшее количество групп с произвольным количеством чисел, сумма которых в группе не превышает K. Судя по всему тут MCH нужен.
Если речь все же про адреса и не превышение 255 символов в них - то можно поискать по форуму по тексту "быстрое удаление ячеек". Там ZVI, насколько помню, приводил пример собирания адресов для удаления по такому же принципу.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
собственно, он был первым, о ком я подумал ответ на ваш вопрос - да, всё верно))
Дмитрий(The_Prist) Щербаков, нашёл КУЧУ тем с тестированием выделения больших диапазонов. Большинство тем так или иначе ссылается на ZVI (даже начиная самостоятельно, как вот тут ) Больше всего понравилась эта тема от bedvit'а, - там и ссылки на ZVI, и новый алгоритм, и разбор. Как в комментариях совершенно верно заметил Казанский - "интерес чисто спортивный", т.к. особо с полученным диапазоном не поработаешь. Понравилась идея с временными именованными диапазонами По созданию текстовой строки адресов из ключей словаря варианта не нашёл (но вряд ли я изобрёл велосипед, так что, скорее всего, просто не увидел). Зато вот тут ZVI очень здорово (хоть и местами не совсем понятно) описывает процедуру накопления текстовой строки.
Основной вывод всех тестов: меньше Union и вообще обращений к листу А уж сколькими способами это всё делается…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
название темы: как из длинной строки с адресами ячеек получить соответствующий диапазон? (к комбинаторике - это имеет такое же отношение, как я к разведению крокодилов в условиях лесостепной зоны) можно использовать функцию AdrTxt2Range, состоящую в сущности из 3-х строк кода))
Код
Function AdrTxt2Range(ws As Worksheet, a$) As Range
Dim p&
If Len(a) < 256 Then Set AdrTxt2Range = ws.Range(a): Exit Function
p = InStrRev(Left(a, 255), ",")
Set AdrTxt2Range = Union(ws.Range(Left(a, p - 1)), AdrTxt2Range(ws, Trim(Right(a, Len(a) - p))))
End Function
Sub Test()
Dim s$, i&, rg As Range
For i = 1 To 256
s = s & ",A" & i
Next
Set rg = AdrTxt2Range(ActiveSheet, Right(s, Len(s) - 1)): rg.Select
MsgBox Mid(s, 2, 1020) & "...", , rg.Address
End Sub
Ігор Гончаренко, Игорь, ну если ставить задачу подбора длинны группы максимально близкой к заветным 256, то можно комбинаторику приплести, но на мой взгляд такая подготовка убьет выгоду по времени которую получим в дальнейших операциях.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ігор и MCH, спасибо вам большое! Ошибка была в некорректном назначении переменной для листа. Необходимо было при вызове функции из макроса всего лишь прописать более полный путь из-за особенностей надстройки. С активным листом работало - вот копал, пока не выяснил
Оставил вариант от MCH, только потому что он не вызывает переполнения памяти (или чего-то там, не помню) на огромных объёмах. А так отличие по скорости в пределах 2% при грубом замере.
Код
Public Function PRDX_AdressToRange(sh As Worksheet, ByVal adr$) As Range
Dim gr As Range, p As Byte
If Len(adr) < 256 Then Set PRDX_AdressToRange = sh.Range(adr): Exit Function
p = InStrRev(Left$(adr, 255), ","): Set gr = sh.Range(Left$(adr, p - 1)): adr = Mid$(adr, p + 1)
While Len(adr) > 255
p = InStrRev(Left$(adr, 255), ",")
Set gr = Union(gr, sh.Range(Left$(adr, p - 1)))
adr = Mid$(adr, p + 1)
Wend
Set PRDX_AdressToRange = Union(gr, sh.Range(adr))
End Function
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄