Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Как обратиться к диапазону из VBA

Полагаю не совру когда скажу, что все кто программирует в VBA очень часто в своих кодах общаются к ячейкам листов. Ведь это чуть ли не основное предназначение VBA в Excel. В принципе ничего сложного в этом нет. Например, чтобы записать в ячейку A1 слово Привет необходимо выполнить код:

Range("A1").Value = "Привет"

Тоже самое можно сделать сразу для нескольких ячеек:

Range("A1:C10").Value = "Привет"

Если необходимо обратиться к именованному диапазону:

Range("Диапазон1").Select

Диапазон1 - это имя диапазона/ячейки, к которому надо обратиться в коде. Указывается в кавычках, как и адреса ячеек.
Но в VBA есть и альтернативный метод записи значений в ячейке - через объект Cells:

Cells(1, 1).Value = "Привет"

Синтаксис объекта Range:
Range(Cell1, Cell2)

  • Cell1 - первая ячейка диапазона. Может быть ссылкой на ячейку или диапазоном ячеек, текстовым представлением адреса или имени диапазона/ячейки. Допускается указание несвязанных диапазонов(A1,B10), пересечений(A1 B10).
  • Cell2 - последняя ячейка диапазона. Необязательна к указанию. Допускается указание ссылки на ячейку, столбец или строку.

Синтаксис объекта Cells:
Cells(Rowindex, Columnindex)

  • Rowindex - номер строки
  • Columnindex - номер столбца

Исходя из этого несложно предположить, что к диапазону можно обратиться, используя Cells и Range:

'выделяем диапазон "A1:B10" на активном листе
Range(Cells(1,1), Cells(10,2)).Select

и для чего? Ведь можно гораздо короче:

Range("A1:B10").Select

Иногда обращение посредством Cells куда удобнее. Например для цикла по столбцам(да еще и с шагом 3) совершенно неудобно было бы использовать буквенное обозначение столбцов.
Объект Cells так же можно использовать для указания ячеек внутри непосредственно указанного диапазона. Например, Вам необходимо выделить ячейку в 3 строке и 2 столбце диапазона "D5:F56". Можно пройтись по листу и посмотреть, отсчитать нужное количество строк и столбцов и понять, что это будет "E7". А можно сделать проще:

Range("D5:F56").Cells(3, 2).Select

Согласитесь, это гораздо удобнее, чем отсчитывать каждый раз. Особенно, если придется оперировать смещением не на 2-3 ячейки, а на 20 и более. Конечно, можно было бы применить Offset. Но данное свойство именно смещает диапазон на указанное количество строк и столбцов и придется уменьшать на 1 смещение каждого параметра для получения нужной ячейки. Да и смещает на указанное количество строк и столбцов весь диапазон, а не одну ячейку. Это, конечно, тоже не проблема - можно вдобавок к этому использовать метод Resize - но запись получится несколько длиннее и менее наглядной:

Range("D5:F56").Offset(2, 1).Resize(1, 1).Select

И неплохо бы теперь понять, как значение диапазона присвоить переменной. Для начала переменная должна быть объявлена с типом Range. А т.к. Range относится к глобальному типу Object, то присвоение значения такой переменной должно быть обязательно с применением оператора Set:

Dim rR as Range
Set rR = Range("D5")

если оператор Set не применять, то в лучшем случае получите ошибку, а в худшем(он возможен, если переменной rR не назначать тип) переменной будет назначено значение Null или значение ячейки по умолчанию. Почему это хуже? Потому что в таком случае код продолжит выполняться, но логика кода будет неверной, т.к. эта самая переменная будет содержать значение неверного типа и применение её в коде в дальнейшем все равно приведет к ошибке. Только ошибку эту отловить будет уже сложнее.
Использовать же такую переменную в дальнейшем можно так же, как и прямое обращение к диапазону:

rR.Select

Вроде бы на этом можно было завершить, но...Это как раз только начало. То, что я написал выше знает практически каждый, кто пишет в VBA. Основной же целью этой статьи было пояснить некоторые нюансы обращения к диапазонам. Итак, поехали.

Обычно макрорекордер при обращении к диапазону(да и любым другим объектам) сначала его выделяет, а потом уже изменяет свойство или вызывает некий метод:

'так выглядит запись слова Test в ячейку А1
Range("A1").Select
Selection.Value = "Test"

Но как правило выделение - действие лишнее. Можно записать значение и без него:

'запишем слово Test в ячейку A1 на активном листе
Range("A1").Value = "Test"

Теперь чуть подробнее разберем, как обратиться к диапазону не выделяя его и при этом сделать все правильно. Диапазон и ячейка - это объекты листа. У каждого объекта есть родитель - грубо говоря это другой объект, который является управляющим для дочернего объекта. Для ячейки родительский объект - Лист, для Листа - Книга, для Книги - Приложение Excel. Если смотреть на иерархию зависимости объектов, то от старшего к младшему получится так:
Applicaton => Workbooks => Sheets => Range
По умолчанию для всех диапазонов и ячеек родительским объектом является текущий(активный) лист. Т.е. если для диапазона(ячейки) не указать явно лист, к которому он относится, в качестве родительского листа для него будет использован текущий - ActiveSheet:

'запишем слово Test в ячейку A1 на активном листе
Range("A1").Value = "Test"

Т.е. если в данный момент активен Лист1 - то слово Test будет записано в ячейку А1 Лист1. Если активен Лист3 - в А1 Лист3. Иначе говоря такая запись равносильна записи:

ActiveSheet.Range("A1").Value = "Test"

Поэтому выхода два - либо активировать сначала нужный лист, либо записать без активации.

'активируем Лист2
Worksheets("Лист2").Select
'записываем слово Test в ячейку A1
Range("A1").Value = "Test"

Чтобы не активируя другой лист записать в него данные, необходимо явно указать принадлежность объекта Range именно этому листу:

'запишем слово Test в ячейку A1 на Лист2 независимо от того, какой лист активен
Worksheets("Лист2").Range("A1").Value = "Test"

Таким же образом происходит считывание данных с ячеек - если не указывать лист, данные ячеек которого необходимо считать - считаны будут данные с ячейки активного листа. Чтобы считать данные с Лист2 независимо от того, какой лист активен применяется такой код:

'считываем значение ячейки A1 с Лист2 независимо от того, какой лист активен
MsgBox Worksheets("Лист2").Range("A1").Value

Т.к. ячейка является частью листа, то лист в свою очередь является частью книги. Исходя из того легко сделать вывод, что при открытых двух и более книгах мы так же можем обратиться к ячейкам любого листа любой открытой книги не активируя при этом ни книгу, ни лист:

'запишем слово Test в ячейку A1 на Лист2 книги Книга2.xlsx независимо от того, какая книга и какой лист активен
Workbooks("Книга2.xlsx").Worksheets("Лист2").Range("A1").Value = "Test"
'считываем значение ячейки A1 с Лист2 книги Книга3.xlsx независимо от того, какой лист активен
MsgBox Workbooks("Книга3.xlsx").Worksheets("Лист2").Range("A1").Value

Важный момент: лучше всегда указать имя книги вместе с расширением(.xlsx, xlsm, .xls и т.д.). Если в настройках ОС Windows(Панель управления -Параметры папок -вкладка Вид -Скрывать расширения для зарегистрированных типов файлов) указано скрывать расширения - то указывать расширение не обязательно - Workbooks("Книга2"). Но и ошибки не будет, если его указать. Однако, если пункт "Скрывать расширения для зарегистрированных типов файлов" отключен, то указание Workbooks("Книга2") обязательно приведет к ошибке.


Очень часто ошибки обращения к ячейкам листов и книг делают начинающие, особенно в циклах по листам. Вот пример неправильного цикла:

Dim wsSh As Worksheet
For Each wsSh In ActiveWorkbook.Worksheets
    Range("A1").Value = wsSh.Name 'записываем в ячейку А1 имя листа
    MsgBox Range("A1").Value 'проверяем, то ли имя записалось
Next wsSh

MsgBox будет выдавать правильные значения, но сами имена листов будут записываться не на каждый лист, а последовательно в ячейку активного листа. Поэтому на активном листе в ячейке А1 будет имя последнего листа.
А вот так выглядит правильный цикл:
Вариант 1 - активация листа(медленный)

Dim wsSh As Worksheet
For Each wsSh In ActiveWorkbook.Worksheets
    wsSh.Activate 'активируем каждый лист
    Range("A1").Value = wsSh.Name 'записываем в ячейку А1 имя листа
    MsgBox Range("A1").Value 'проверяем, то ли имя записалось
Next wsSh

Вариант 2 - без активации листа(быстрый и более правильный)

Dim wsSh As Worksheet
For Each wsSh In ActiveWorkbook.Worksheets
    wsSh.Range("A1").Value = wsSh.Name 'записываем в ячейку А1 имя листа
    MsgBox wsSh.Range("A1").Value 'проверяем, то ли имя записалось
Next wsSh

Вариант 3 - без активации листа, используем With(тоже быстрый и более правильный)

Dim wsSh As Worksheet
For Each wsSh In ActiveWorkbook.Worksheets
    With wsSh 
        .Range("A1").Value = .Name 'записываем в ячейку А1 имя листа
        MsgBox .Range("A1").Value 'проверяем, то ли имя записалось
    End With
Next wsSh

Конструкция With позволяет обратиться к объекту внутри блока With ... End With, не указывая сам объект, а ставя перед свойством/методом только точку. Точка обязательна, она указывает именно на то, что мы хотим обратиться к тому объекту, который указан после ключевого With(выше это объект листа - wsSh). Если точку не указать, то обращение будет к тому объекту, который активный на данный момент(в цикле выше - активный лист).

Важно: если код записан в модуле листа(правая кнопка мыши на листе-Исходный текст) и для объекта Range или Cells родитель явно не указан(т.е. нет имени листа и книги) - тогда в качестве родителя будет использован именно тот лист, в котором записан код, независимо от того какой лист активный. Иными словами - если в модуле листа записать обращение вроде Range("A1").Value = "привет", то слово "привет" всегда будет записываться в ячейку A1 именно того листа, в котором записан сам код. Это следует учитывать, когда располагаете свои коды внутри модулей листов.

В конструкциях типа Range(Cells(,),Cells(,)) Range является контейнером, в котором перечисляются ссылки на объекты(ячейки), из которых и будет создана окончательная ссылка на диапазон.
Предположим, что активен "Лист1", а код запущен с листа "Итог".
Если запись будет вида

Sheets("Итог").Range(Cells(1, 1), Cells(10, 1))

это вызовет ошибку "Run-time error '1004': Application-defined or object-defined error". Ошибка появляется потому, что контейнер и объекты внутри него не могут располагаться на разных листах. Т.е. у нас контейнер Range указано брать с листа "Итог"(Sheets("Итог").Range), а составляющие его ячейки будут взяты с активного листа, т.к. перед Cells нет указания конкретного листа(родителя).
Еще пример неправильных записей:

Sheets("Итог").Range(Cells(1, 1), Sheets("Итог").Cells(10, 1))
'запись ниже так же неверна
Range(Cells(1, 1), Sheets("Итог").Cells(10, 1))

т.к. ссылки на объекты внутри контейнера так же относятся к разным листам. Cells(1, 1) - к активному листу, а Sheets("Итог").Cells(10, 1) - к листу Итог.
А вот такие записи будут правильными:

Sheets("Итог").Range(Sheets("Итог").Cells(1, 1), Sheets("Итог").Cells(10, 1))
Range(Sheets("Итог").Cells(1, 1), Sheets("Итог").Cells(10, 1))

Вторая запись не содержит ссылки на родителя для Range, но ошибки это в большинстве случаев не вызовет - т.к. если для контейнера ссылка не указана, а для двух объектов внутри контейнера родитель один - он будет применен и для самого контейнера. Однако лучше делать как в первой строке - т.е. с обязательным указанием родителя для контейнера и для его составляющих. Т.к. при определенных обстоятельствах(например, если в момент обращения к диапазону активной является книга, открытая в режиме защищенного просмотра) обращение к Range без родителя может вызывать ошибку выполнения. Так же такое обращение вызовет ошибку, если мы запишем такой код в модуле листа и это будет не лист "Итог".
Если запись будет вида Range("A1","A10"), то указывать ссылку на родителя внутри Range не обязательно - достаточно будет указать эту ссылку перед самим Range - Sheets("Итог").Range("A1","A10"), т.к. текстовое представление адреса внутри Range не является объектом(у которого может быть какой-то родительский объект), что обязывает создать ссылку именно на родителя контейнера.

Разберем пример, приближенный к жизненной ситуации. Необходимо на лист Итог занести формулу вычитания, начиная с ячейки А2 и до последней заполненной. На момент записи активен Лист1. Очень часто начинающие записывают так:

Sheets("Итог").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) _
                                        .FormulaR1C1 = "=RC2-RC11"

Запись смешанная - и текстовое представление адреса ячейки("A2:A") и ссылка на объект Cells. В данном случае явную ошибку код не вызовет, но и работать будет не всегда так, как хотелось бы. А это самое плохое, что может случиться при разработке.
Sheets("Итог").Range("A2:A" - создается ссылка на столбец "A" листа Итог. Но далее идет вычисление последней строки первого столбца. И вот как раз это вычисление происходит на основе объекта Cells, который не содержит в себе ссылки на родительский объект. А значит он будет вычислять последнюю строку исключительно для текущего листа(если код записан в стандартном модуле, а не модуле листа) - т.е. для Лист1. Правильно было бы записать так:

Sheets("Итог").Range("A2:A" & Sheets("Итог").Cells(Rows.Count, 1).End(xlUp).Row) _
                                                      .FormulaR1C1 = "=RC2-RC11"

Но и здесь неверное обращение с диапазоном может сыграть злую шутку. Например, надо получить последнюю заполненную ячейку в конкретной книге:

lLastRow = Workbooks("Книга3.xls").Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row

с виду все нормально, но есть нюанс. Rows.Count по умолчанию будет относится к активной книге, если записано в стандартном модуле. Приведенный выше код должен работать с книгой формата 97-2003 и вычислить последнюю заполненную ячейку на листе1. В книгах формата Excel 97-2003(.xls) всего 65536 строк. Если в момент выполнения приведенной строки активна книга формата 2007 и выше(форматы .xlsx, .xlsm, .xlsb и пр) - то Rows.Count вернет 1048576, т.к. именно такое количество строк в листах книг версий Excel, начиная с 2007. И т.к. в книге, в которой мы пытаемся вычислить последнюю строку всего 65536 строк - получим ошибку 1004, т.к. не может быть номера строки 1048576 на листе с количеством строк 65536. Поэтому имеет смысл указывать явно откуда считывать Rows.Count:

lLastRow = Workbooks("Книга3.xls").Sheets("Лист1").Cells(Workbooks("Книга3.xls").Sheets("Лист1").Rows.Count, 1).End(xlUp).Row

или применить конструкцию With

With Workbooks("Книга3.xls").Sheets("Лист1")
    lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

Когда применяете конструкцию With всегда обращайте внимание на точки перед объектами. Конструкция With как бы сокращает обращение к объектам. Все, что находится между With и End With - будет обращаться к тому объекту, который мы записали внутри этой конструкции. Но здесь нюанс: мы обязаны указать VBA, что мы используем обращение именно к этому объекту. И делается это проставлением точки перед объектом: .Cells. Т.е. когда мы записали With Workbooks("Книга3.xls").Sheets("Лист1"), то если хотим обращаться к ячейкам этого листа, мы должны перед ними ставить точку. Если точку не поставить - то обращение будет идти опять же к активному листу:

With Workbooks("Книга3.xls").Sheets("Лист1")
    'перед Rows.Count нет точки - значит вычисление кол-ва строк будет все так же на активном листе
    lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    'перед Cells нет точки - значит обращение будет к ячейкам на активном листе
    lLastRow = Cells(.Rows.Count, 1).End(xlUp).Row
    'правильное обращение - точки перед всеми объектами
    .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1).FormulaR1C1 = "=RC2-RC11"
End With

Но даже из этого можно вынести свою пользу - например, в первую пустую ячейку столбца "A" листа "Итог" книги "Отчет" необходимо занести значение ячейки "B10" активного листа. Все сводится к одной строке кода:

With Workbooks("Отчет.xlsx").Sheets("Отчет")
    'вычисляем первую пустую ячейку в столбце А
    Dim llastr As Long
    llastr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    'записываем в эту ячейку значение ячейки "В10" активного листа
    'в левой части обращаемся к листу "Итог" книги "Отчет" - точка перед Cells
    'в правой части обращаемся к активному листу - точки нет
    .Cells(llastr, 1).Value = Range("B10").Value
End With

Также не мешало бы упомянуть возможность выделения несмежного диапазона(часто его называют "рваным"). Это диапазон, который обычно привыкли выделять на листе при помощи зажатой клавиши Ctrl. Что это дает? Это дает возможность выделить одновременно ячейки A1 и B10 и записать значения только в них. Для этого есть несколько способов. Самый очевидный и описанный в справке - метод Union:

Union(Range("A1"), Range("B10")).Value = "Привет"

Однако существует и другой метод:

Range("A1,B10").Value = "Привет"

В чем отличие(я бы даже сказал преимущество) Union: можно применять в цикле по условию. Например, выделить в диапазоне A1:F50 только те ячейки, значение которых больше 10 и меньше 20:

Sub SelOne()
    Dim rCell As Range, rSel As Range
    For Each rCell In Range("A1:F50")
        If rCell.Value > 10 And rCell.Value < 20 Then
            If rSel Is Nothing Then
                Set rSel = rCell
            Else
                Set rSel = Union(rSel, rCell)
            End If
        End If
    Next rCell
    If Not rSel Is Nothing Then rSel.Select
End Sub

Конечно, можно и просто в Range через запятую передать все эти ячейки, сформировав предварительно строку. Но в случае со строкой действует ограничение: длина строки не должна превышать 255 символов. У Union есть свои нюансы, связанные со скоростью его наполнения - но это тема уже совсем другая :)

Надеюсь, что после прочтения данной статьи проблем с обращением к диапазонам и ячейкам у Вас будет гораздо меньше.

Также см.:
Как определить последнюю ячейку на листе через VBA?
Как определить первую заполненную ячейку на листе?
Как из Excel обратиться к другому приложению


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 23 комментария
  1. Татьяна:

    Мне очень надо научиться писать макросы. Прочитав статью(( я поняла, что НЕ ПОНЯЛА НИ СЛОВА ((((

  2. Татьяна:

    А вот ВПР написала для работы моментально))

  3. Татьяна, статья не направлена научить писать процедуры, макросы и пр. Она лишь показывает как правильно обратиться к диапазону ячеек. Чтобы научиться - прочитайте какую-нибудь книжку.

  4. Вадим:

    Столкнулся с задачей определения не сплошного диапазона при динамическом формирования диаграммы по сводной таблице.
    Проблема в том что график строится по значениям 5,8,11 и тд через 3 колонки.
    Создаю в диаграмме ряд (ряды...) и каждому пытаюсь присвоить диапазон ячеек.
    Если вот так:
    ActiveChart.SeriesCollection(j).Values = ActiveSheet.Range(ActiveSheet.Cells(i, 5), ActiveSheet.Cells(i, 11))
    то работает, но диаграмма строится по всему диапазону ячеек от 5 до 11.
    Пробую так:
    ActiveChart.SeriesCollection(j).Values = _
    "='Отчет'!$E$8;'Отчет'!$H$8;'Отчет'!$K$8"
    Вылетает сообщение - Run-time error '1004' и ... фигушки :)
    Думал туплю - записал автомакрос - так он тоже не исполняется :)
    Может подскажите что?

  5. подскажу - статью прочитали невнимательно, справку по Range тоже не читали. Указывая Range через Cells - Вы указываете непрерывный диапазон, начинающийся с первой указанной ячейки и завершающийся на второй. Попробуйте так указать:

    ActiveChart.SeriesCollection(j).Values = Union(Cells(8,5),Cells(8,8),Cells(8,11))

    или

    ActiveChart.SeriesCollection(j).Values = Range("E8,H8,K8")

    или

    ActiveChart.SeriesCollection(j).Values = Range("E8,H8,K8")

    Если не поможет - обращайтесь в форум. Создайте там тему, приложите пример и с большой вероятностью получите ответ.

  6. Дмитрий:

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

  7. Александр:

    Уважаемый Дмитрий, проверьте, пожалуйста, не ошибка ли здесь:
    'запишем слово Test в ячейку A1 на Лист2 независимо от того, какой лист активен
    Worksheets("Лист2").Value = "Test"

    К сожалению, у меня это выражение выдает ошибку.
    Может быть нужно написать:
    Worksheets("Лист3").Range("A1").Value = "Test"

  8. Александр:

    Еще было бы хорошо исправить опечатку в абзаце:
    Если запись будет вида Range("A1","A10"), то указывать ссылку на родителя внутри Range не обязательно - достаточно будет указать эту ссылку перед самим Range - Sheets("Итог")Range("A1","A10"), т.к. текстовое представление адреса внутри Range обязывает создать ссылку именно на родителя контейнера.

    В выражении:
    Sheets("Итог")Range("A1","A10")
    между именами объектов, кажется, нужно бы поставить точку:
    Sheets("Итог").Range("A1","A10")

  9. SvetaS:

    Добрый День! Вы хорошо описываете обращение к диапазонам, может тогда можете подсказать? Проблема в следующем "при обработке динамического массива на больших объёмах команда Redim выдаёт ошибку "RunTime Error 7 - Out of Memory ". Она вылезает или на ReDim массива, или на присвоении массиву диапазона с листа.

    ПАМЯТИ 8 ГБ, Excel 64 РАЗРЯДНЫЙ, ОПЕРАЦИОНКА 64 РАЗРЯДНАЯ, Excel 2016
    ошибку даёт Redim на 111 533 строках и 1635 столбцах
    на объёме маленьком ошибку не даёт (до 100 строк и до 100 столбцов) - работает нормально......

    Может можно как-то заменить использование динамического массива на использование динамического диапазона? Если да, то как?
    место ошибки:
    Dim text_word2() As Variant
    .......................
    ReDim text_word2(0 To kki, 0 To x)- место ошибки

    Если ошибку отлавливать

    Private Sub CommandButton3_Click()
    Dim n As Long
    Dim nn As Long
    Dim find As String
    Dim kki, kkj As Integer
     
    Dim k, kk, ii, i, j, jj, l, ll, jjj, i1, i2, kkk, j1, j2, j3, i3, jj3, eqmax As Long
    Dim ii_find, jj_find, ii_text, jj_text As Long
    Dim Txt, txt2, txt_p, txt_col, txt_row, txt_out As String
     
     
         Dim Rng_find As Range
         Dim Rng_text As Range
         Dim Rng_substitution As Range
         Dim Rng_out As Range
         Dim theRange_out As Range
         Dim Delimiter As String
     
    '  Dim Max() As Variant
    Dim Find_word() As String
    Dim Find_word2() As String
    Dim text_word1() As String
    Dim text_word2() As Variant
     
        On Error Resume Next
        Set Rng_find = Range(RefEdit1.Value)
     
        Set Rng_text = Range(RefEdit2.Value)
        Set Rng_substitution = Range(RefEdit3.Value)
        Set Rng_out = Range(RefEdit4.Value)
        Delimiter = Me.TextBox1
     
     
        On Error GoTo 0
     
     
     
        If Rng_find Is Nothing Then
            MsgBox "вы не выбрали диапазон какие данные ищем"
            Err.Clear
        Else
        If Rng_text Is Nothing Then
            MsgBox "вы не выбрали диапазон в котором ищем данные "
            Err.Clear
        Else
     
          If Rng_out Is Nothing Then
             MsgBox "вы не выбрали диапазон куда выводить данные"
             Err.Clear
          Else
     
        Application.ScreenUpdating = False
     
        If myWord(Rng_text).imyRows > myWord(Rng_text).imyColumns Then 'если строк больше чем столбцов в тексте в котором ищем
     
       'раскладываем по словам искомый диапазон
        ii_find = myWord(Rng_find).imyRows
        jj_find = myWord(Rng_find).imyColumns
     
     
        ReDim Find_word(1 To ii_find, 0 To jj_find) ' 0-вой столбец фраза целиком
        Find_word = myWord(Rng_find).iFindword
     
         ' переводим в массив 2-ух строк
         ' 0 строка фраза целиком
         ' 1 строка разложение по словам
        ReDim Find_word2(0 To 2, 0 To (jj_find * ii_find))  '
        jjj = 1
       For i = 1 To ii_find
         For j = 1 To jj_find
           If ((Find_word(i, j)  "") And (Find_word(i, j)  " ") And (Find_word(i, j)  Empty) And (Len(Find_word(i, j)) > 2)) Then
              Find_word2(0, jjj) = Find_word(i, 0)
              Find_word2(1, jjj) = Find_word(i, j)
              jjj = jjj + 1
           End If
         Next j
       Next i
     
        'раскладываем по словам  диапазон в котором ищем
        ii_text = myWord(Rng_text).imyRows
        jj_text = myWord(Rng_text).imyColumns
        ReDim text_word1(1 To ii_text, 0 To jj_text) ' 0-вой столбец фраза целиком
        text_word1 = myWord(Rng_text).iFindword
    '______________
     
    'определение % совпадения каждого слова в строке в масиве  text_word2(i, j)
    kkj = jj_text + jjj + 2
    kki = ii_text + 2
    ReDim text_word2(0 To kki, 0 To kkj)
    On Error Resume Next
    If Err.Number  0 Then
    Err.Clear
    End If
     
     
     
       '-составляем массив в котором будем сопоставлять
     
        For j = 0 To jj_text
             i2 = 3
            For i = 1 To (ii_text) 'заполнение массива
     
             text_word2(0, j) = "где ищем"
     
             text_word2(i2, j) = text_word1(i, j)
             i2 = i2 + 1
            Next i
          Next j
    ' первая строка - группы- искомые слова исходном виде- строка 0
    ' вторая строка - группы- искомые слова в разложенном виде - строка 1
       For i = 1 To 2 'заполнение массива
         kkk = jj_text + 1
          For jj = 1 To jjj
              text_word2(0, kkk) = "что ищем"
              text_word2(i, kkk) = Find_word2((i - 1), jj)
              kkk = kkk + 1
             Next jj
     
        Next i
     
      For i = 3 To i2 - 1 'получаем % совпадения искомых слов
     
           For jj = (jj_text + 1) To kkk
           eqmax = 0
             For jj3 = 1 To jj_text
              If text_word2(i, jj3)  Empty Then
                 If Equality(CStr(text_word2(i, jj3)), CStr(text_word2(2, jj))) > eqmax Then
                    text_word2(i, jj) = CDbl(CDbl(Equality(CStr(text_word2(i, jj3)), CStr(text_word2(2, jj))) / Len(CStr(text_word2(2, jj)))))
     
                    eqmax = Equality(CStr(text_word2(i, jj3)), (CStr(text_word2(2, jj))))
                 End If
                  If eqmax < 3 Then text_word2(i, jj) = ""
              End If
             Next jj3
            Next jj
         Next i
     
     
     
     
     
     
     
     
      ElseIf myWord(Rng_text).imyRows < myWord(Rng_text).imyColumns Then &#039;если столбцов больше чем строк в тексте в котором ищем
     
      Else
     
     
      End If
     
     
      &#039;динамический расчёт вставляемого массива от заданной ячейки полбзователем
     
     txt_p = Substring(RefEdit4.Text, "!", 1)
     txt_col = Substring(Substring(RefEdit4.Text, "!", 2), "$", 2)
     txt2 = Substring(Substring(RefEdit4.Text, "!", 2), "$", 3)
     txt_row = Substring(txt2, ":", 1)
    &#039;MsgBox
     i = jj_text + jjj + 2 + Int(Columns(txt_col).Column)
     
     txt_out = txt_col & txt_row & ":" & Trim(Substring(Cells(1, i).Address, "$", 2)) & Trim(Str((ii_text + 2) + Int(txt_row)))
     
    &#039;вставка итогового массива
          ActiveWorkbook.ActiveSheet.Range(txt_out).Clear
           Set theRange_out = ActiveWorkbook.ActiveSheet.Range(txt_out)
             theRange_out = text_word2
     
     
          End If
        End If
      End If

    - то Excel виснит и уходит в бесконечный цикл, постоянно увеличивая занимаемую память.

    Может можно как-то заменить использование динамического массива на использование динамического диапазона? Если да, то как?

    ПОМОГИТЕ ПОЖАЛУЙСТА.
    ЗАРАНЕЕ СПАСИБО.
    полный код:

    Private Sub CommandButton3_Click()
    Dim n As Long
    Dim nn As Long
    Dim find As String
    Dim kki, kkj As Integer
     
    Dim k, kk, ii, i, j, jj, l, ll, jjj, i1, i2, kkk, j1, j2, j3, i3, jj3, eqmax As Long
    Dim ii_find, jj_find, ii_text, jj_text As Long
    Dim Txt, txt2, txt_p, txt_col, txt_row, txt_out As String
     
     
         Dim Rng_find As Range
         Dim Rng_text As Range
         Dim Rng_substitution As Range
         Dim Rng_out As Range
         Dim theRange_out As Range
         Dim Delimiter As String
     
    '  Dim Max() As Variant
    Dim Find_word() As String
    Dim Find_word2() As String
    Dim text_word1() As String
    Dim text_word2() As Variant
     
        On Error Resume Next
        Set Rng_find = Range(RefEdit1.Value)
     
        Set Rng_text = Range(RefEdit2.Value)
        Set Rng_substitution = Range(RefEdit3.Value)
        Set Rng_out = Range(RefEdit4.Value)
        Delimiter = Me.TextBox1
     
     
        On Error GoTo 0
     
     
     
        If Rng_find Is Nothing Then
            MsgBox "вы не выбрали диапазон какие данные ищем"
            Err.Clear
        Else
        If Rng_text Is Nothing Then
            MsgBox "вы не выбрали диапазон в котором ищем данные "
            Err.Clear
        Else
     
          If Rng_out Is Nothing Then
             MsgBox "вы не выбрали диапазон куда выводить данные"
             Err.Clear
          Else
     
        Application.ScreenUpdating = False
     
        If myWord(Rng_text).imyRows > myWord(Rng_text).imyColumns Then 'если строк больше чем столбцов в тексте в котором ищем
     
       'раскладываем по словам искомый диапазон
        ii_find = myWord(Rng_find).imyRows
        jj_find = myWord(Rng_find).imyColumns
     
     
        ReDim Find_word(1 To ii_find, 0 To jj_find) ' 0-вой столбец фраза целиком
        Find_word = myWord(Rng_find).iFindword
     
         ' переводим в массив 2-ух строк
         ' 0 строка фраза целиком
         ' 1 строка разложение по словам
        ReDim Find_word2(0 To 2, 0 To (jj_find * ii_find))  '
        jjj = 1
       For i = 1 To ii_find
         For j = 1 To jj_find
           If ((Find_word(i, j)  "") And (Find_word(i, j)  " ") And (Find_word(i, j)  Empty) And (Len(Find_word(i, j)) > 2)) Then
              Find_word2(0, jjj) = Find_word(i, 0)
              Find_word2(1, jjj) = Find_word(i, j)
              jjj = jjj + 1
           End If
         Next j
       Next i
     
        'раскладываем по словам  диапазон в котором ищем
        ii_text = myWord(Rng_text).imyRows
        jj_text = myWord(Rng_text).imyColumns
        ReDim text_word1(1 To ii_text, 0 To jj_text) ' 0-вой столбец фраза целиком
        text_word1 = myWord(Rng_text).iFindword
    '______________
     
    'определение % совпадения каждого слова в строке в масиве  text_word2(i, j)
    kkj = jj_text + jjj + 2
    kki = ii_text + 2
    ReDim text_word2(0 To kki, 0 To kkj)
    On Error Resume Next
    If Err.Number  0 Then
    Err.Clear
    End If
     
     
     
       '-составляем массив в котором будем сопоставлять
     
        For j = 0 To jj_text
             i2 = 3
            For i = 1 To (ii_text) 'заполнение массива
     
             text_word2(0, j) = "где ищем"
     
             text_word2(i2, j) = text_word1(i, j)
             i2 = i2 + 1
            Next i
          Next j
    ' первая строка - группы- искомые слова исходном виде- строка 0
    ' вторая строка - группы- искомые слова в разложенном виде - строка 1
       For i = 1 To 2 'заполнение массива
         kkk = jj_text + 1
          For jj = 1 To jjj
              text_word2(0, kkk) = "что ищем"
              text_word2(i, kkk) = Find_word2((i - 1), jj)
              kkk = kkk + 1
             Next jj
     
        Next i
     
      For i = 3 To i2 - 1 'получаем % совпадения искомых слов
     
           For jj = (jj_text + 1) To kkk
           eqmax = 0
             For jj3 = 1 To jj_text
              If text_word2(i, jj3)  Empty Then
                 If Equality(CStr(text_word2(i, jj3)), CStr(text_word2(2, jj))) > eqmax Then
                    text_word2(i, jj) = CDbl(CDbl(Equality(CStr(text_word2(i, jj3)), CStr(text_word2(2, jj))) / Len(CStr(text_word2(2, jj)))))
     
                    eqmax = Equality(CStr(text_word2(i, jj3)), (CStr(text_word2(2, jj))))
                 End If
                  If eqmax < 3 Then text_word2(i, jj) = ""
              End If
             Next jj3
            Next jj
         Next i
     
     
     
     
     
     
     
     
      ElseIf myWord(Rng_text).imyRows < myWord(Rng_text).imyColumns Then &#039;если столбцов больше чем строк в тексте в котором ищем
     
      Else
     
     
      End If
     
     
      &#039;динамический расчёт вставляемого массива от заданной ячейки полбзователем
     
     txt_p = Substring(RefEdit4.Text, "!", 1)
     txt_col = Substring(Substring(RefEdit4.Text, "!", 2), "$", 2)
     txt2 = Substring(Substring(RefEdit4.Text, "!", 2), "$", 3)
     txt_row = Substring(txt2, ":", 1)
    &#039;MsgBox
     i = jj_text + jjj + 2 + Int(Columns(txt_col).Column)
     
     txt_out = txt_col & txt_row & ":" & Trim(Substring(Cells(1, i).Address, "$", 2)) & Trim(Str((ii_text + 2) + Int(txt_row)))
     
    &#039;вставка итогового массива
          ActiveWorkbook.ActiveSheet.Range(txt_out).Clear
           Set theRange_out = ActiveWorkbook.ActiveSheet.Range(txt_out)
             theRange_out = text_word2
     
     
          End If
        End If
      End If

    ПОМОГИТЕ ПОЖАЛУЙСТА.
    ЗАРАНЕЕ СПАСИБО.

    • SvetaS, я дал Вам ответ на cyberforum:
      "Я выходил из такой ситуации следующим образом:
      вычислял общее кол-во строк
      определял кол-во проходов по массиву так, чтобы за один проход в массив загонялось не более 2000 строк(при условии 30 с лишним столбцов)
      и так кусками обрабатывал."
      Другого выхода из ситуации нет. Потому что ошибка означает, что у Вас нехватка памяти для создания массива такого размера. И 100% избежать этой ошибки можно только созданием массива меньшей размерности, что достигается только путем "разбиения исходного диапазона на куски".

      P.S. Кстати, судя по приведенному Вами коду Вам не мешало бы ознакомиться со статьёй: Что такое переменная и как правильно её объявить?

  10. Ренат:

    Sheets("Итог").Range(Sheets("Итог").Cells(1, 1), Sheets("Итог").Cells(10, 1))
    можно Sheets("Итог").Range(Cells(1, 1).address, Cells(10, 1).address)

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти