Excel макрос выбрать данные

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Добрый день, нужен макрос для выборки данных и заполнению таблицы.    
Файл стаблицами и условиями прилагаю. Помогите с макросом.

 

По Вашему алгоритму:  
1. Ищем на исходной таблице значения с номером 76232 (строки с 29 по 58)  
2. Находим максимальное АБСОЛЮТНОЕ значение из колонки N в найденных строках (161,091) и соответствующие значения Му (-1,707) и Мz(-8,428)  
3. Суммируем значения =161,091+(-1,707)+(-8,428)=150,956  
4. Находим следующее максимальное абсолютное значение из колонки N в найденных строка (160,497), Му(-1,93), Mz(-8.437)  
5. Суммируем 160,497-1,93-8,437=150,13  
6. Сравниваем — наибольший результат дает 1 комбинация (150,956)  
7. Записываем в строку 3 таблицы на листе 1 значения -161,091  -1,707 -8,428  
Пока все правильно?  
«…дальше все тоже самое, но только по колонке Му» — не понял вообще. В туже строку таблицы результатов писать? Максимальное абсолютное значение складывать с N и Мz?  

  Как надо-то?  
Наверное, было бы лучше, если б Вы в примере хотя б 2 строчки заполнили в результирующей таблице руками с пояснениями — это так получилось, это сяк и т.д.  
Пока я не могу понять алгоритм заполнения.  

    ВАУ! 44288

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Заполнила результирующую таблицу, разным цветом выделила выбранные значения по N и My

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Уважаемые форумчане!  

  Помогите, очень надо решить данную задачку, а знаний в макрасах чуть-чуть….

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Макрос выборки данных по колонке N написала:  

  Public Sub Заполнить максзначение по N()  
   Const rowStart = 8  
   Const colID = 1  
   Const colN = 4    
   Const colMy = 6    
   Const colMz = 7      
   Const rowResStart = 3    
   Const colResID = 7      
   Const colResN = 2    
   Const colResMy = 3    
   Const colResMz = 4    
   Const shtSource = «1. Усилия и напряжения комбин»  
   Const shtResult = «Лист1»  

         Dim lngRow As Long  
   Dim lngInd As Long  
   Dim strRead As String  
   Dim strFind As String  
   Dim varN As Variant  
   Dim varMy As Variant  
   Dim varMz As Variant  
   Dim varNewN As Variant  
   Dim varNewMy As Variant  
   Dim varNewMz As Variant  

               lngInd = rowResStart  
   strRead = Trim$(ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResID).Value)  
   Do While strRead <> «»  

                 If IsNumeric(strRead) Then  
           varN = 0  
           varMy = 0  
           varMz = 0  
           lngRow = rowStart  
           strFind = Trim$(ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colID).Value)  
           Do While strFind <> «»  

                                 If CLng(strFind) > CLng(strRead) Then Exit Do  

                                 If CLng(strFind) = CLng(strRead) Then  
                   varNewN = ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colN).Value  
                   varNewMy = ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colMy).Value  
                   varNewMz = ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colMz).Value  

                                         If Abs(varNewN) >= Abs(varN) Then  
                       varN = varNewN  
                       varMy = varNewMy  
                       varMz = varNewMz  
                   End If  

                                     End If  

                                                   lngRow = lngRow + 1  
               strFind = Trim$(ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colID).Value)  
           Loop  

                                       ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResN).Value = varN  
           ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResMy).Value = varMy  
           ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResMz).Value = varMz  

                 End If  

                 lngInd = lngInd + 1  
       strRead = Trim$(ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResID).Value)  
   Loop  

      End Sub  

      а как и что дальше незнаю……  
Помогите, пожлуйста!

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

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

  Sub tt()  
   Dim a, b  
   a = [g3:g10] ‘ массив номеров
   b = Sheets(1).[a2:f178] ‘ массив значений
   For i = 1 To UBound(a) ‘цикл по номерам  
       If a(i, 1) > 0 Then ‘только значения объединённых ячеек  
       maxb = 0: maxb2 = 0: maxbind = 0: maxb2ind = 0 ‘обнуляем максимальные и номера нужных индексов значений массива  
           For ii = 1 To UBound(b) ‘цикл по значениям  
               If b(ii, 1) = a(i, 1) Then ‘если совпадает  
                   If Abs(b(ii, 4)) > maxb Then ‘если максимальное  
                       maxb2 = maxb: maxb2ind = maxbind ‘запоминаем предыдущее максимальное и его положение в массиве  
                       maxb = Abs(b(ii, 4)): maxbind = ii ‘запоминаем  максимальное и его положение в массиве  
                   End If  
               End If  
           Next  
           ‘сравниваем суммы  
           If Abs(b(maxbind, 4)) + Abs(b(maxbind, 5)) + Abs(b(maxbind, 6)) >= Abs(b(maxb2ind, 4)) + Abs(b(maxb2ind, 5)) + Abs(b(maxb2ind, 6)) Then  
           MsgBox maxbind ‘озвучиваем индекс нужного значения массива  
           Else  
           MsgBox maxb2ind  
           End If  
       End If  
   Next  
End Sub

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

эээ, не по по второму столбцу номеров, а определение максимальных по My…

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

стоп, ошибка в алгоритме определения немаксимального… после максимума меньшее не определяется.

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Проверяйте.  
Не понял, что там справа внизу за маленькие таблицы (Выборка по максимальному N).  
Но и их сформировать не трудно.

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Большое спасибо! это почти то, что надо )  
вот если бы для позиции он делал бы проверку не по одному номеру(из колонки G) а по обоим номерам (G и H)  
и почему то когда я добавляю новые позиции (337, 338 итд) он отказыается считать дальше…  

  А в остальном все супер!

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

{quote}{login=Natali}{date=08.10.2010 07:22}{thema=}{post}Большое спасибо! это почти то, что надо )  
вот если бы для позиции он делал бы проверку не по одному номеру(из колонки G) а по обоим номерам (G и H)  
и почему то когда я добавляю новые позиции (337, 338 итд) он отказыается считать дальше…  

  А в остальном все супер!{/post}{/quote}  

  Да, точно, забыл массив «c» сделать динамическим. Надо так изменить этот блок:  

     a = Range(«g3:g» & Range(«G» & Rows.Count).End(xlUp).Row)  ‘ массив номеров  
   b = Sheets(1).Range(«a2:f» & Sheets(1).Range(«F» & Rows.Count).End(xlUp).Row)    ‘ массив значений  
   ReDim c(1 To Range(«G» & Rows.Count).End(xlUp).Row, 1 To 3) ‘массив результатов  

  Но тут рассчитано, что в столбце G будут объединённые попарно ячейки — иначе может места для всех значений не хватить. А так берётся двойное количество объединённых -1  + 2(шапка) — как раз хватает с хвостиком :)  
А вот про «а по обоим номерам (G и H)» не понял — где номера из Н на первом листе, и куда писать полученные данные, если их получим?  
Но имхо это можно сделать вторым аналогичным кодом вторым заходом, если вставить в этот будет затруднительно — меняем в этом коде привязку к диапазонам и всё.

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

УРРРАААА )))) работает!!!    
В том файле приведена только маленькая часть таблицы, в которую элементы из столбца H не попали…реальная таблица имеет порядка 20000 строк )    

  Мы уже получили необходимый нам результат — 6 значений! которые относятся к позиции из первого столбца. Но эта позиция состоит из нескольких элементов. (К примеру Поз. 333 из элементов 76232 и 81984). Тоесть нам надо сделать ту же самую выборку, только в более широком диапазоне

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Ну так если в моём коде разберётесь (я думаю можно разобраться) — его легко масштабировать и переделывать.  
А скорость на массивах позволяет и несколько разных копий кода в цепочку ставить — будет вместо 3-х секунд 6 работать…

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

разберусь! огромное спасибо! )

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Hugo, уделите еще минуточку пожалуйста…  
Мне кажется, что решение второго максимума должно немного по другому выглядеть…  

  If Abs(b(ii, 4)) > maxb2 Then      
   If Abs(b(ii, 4)) > maxb Then  
       maxb2 = maxb: maxb2ind = maxbind      
       maxb = Abs(b(ii, 4)): maxbind = ii      
   Else                              
       maxb2 = Abs(b(ii, 4)): maxbind = ii        
   End If  
End If  

  Я правильно думаю?

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Да, что-то там у меня неправильно… хотя результат от Вашего кода на примере не отличается.  
Но проверка условия в Вашем коде  
If Abs(b(ii, 4)) > maxb Then  
у Вас лишняя, т.к. это проверено уже выше по коду и там уже присвоено  
maxb = Abs(b(ii, 4))  
т.е. Abs(b(ii, 4)) > maxb уже никогда не будет.  
А только Ваш код без моей первой проверки результат дат совсем другой.  
Я ведь тоже такую задачу раньше не решал — так что решаю эту головоломку на равне с Вами, тут уже не знания ВБА нужны, а чисто логика…  
Подумаю попозже, что-то пока не складывается.

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Вроде так правильно (на оба столбца, N и My), взгляните со стороны:  

                     If Abs(b(ii, 4)) > maxb Then    ‘если максимальное  
                       maxb2 = maxb: maxb2ind = maxbind    ‘запоминаем предыдущее максимальное и его положение в массиве  
                       maxb = Abs(b(ii, 4)): maxbind = ii    ‘запоминаем  максимальное и его положение в массиве  
                   End If  

                     If Abs(b(ii, 4)) <> maxb Then    ‘ отсекаем обработку первого максимального  
                       If Abs(b(ii, 4)) > maxb2 Then    ‘если второе максимальное  
                           maxb2 = Abs(b(ii, 4)): maxb2ind = ii    ‘запоминаем  максимальное и его положение в массиве  
                       End If  
                   End If  

                     If Abs(b(ii, 5)) > maxbmy Then    ‘если максимальное  
                       maxbmy2 = maxbmy: maxbmy2ind = maxbmyind    ‘запоминаем предыдущее максимальное и его положение в массиве  
                       maxbmy = Abs(b(ii, 5)): maxbmyind = ii    ‘запоминаем  максимальное и его положение в массиве  
                   End If  
                   If Abs(b(ii, 5)) <> maxbmy Then    ‘ отсекаем обработку первого максимального  
                       If Abs(b(ii, 5)) > maxbmy2 Then    ‘если второе максимальное  
                           maxbmy2 = Abs(b(ii, 5)): maxbmy2ind = ii    ‘запоминаем  максимальное и его положение в массиве  
                       End If  
                   End If

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Хм…мне кажется, что у нас одно и тоже написано, только мы по разному отсекаем maxb…а в моем коде просто ошибка была в 6ой строке:  
maxb2 = Abs(b(ii, 4)): maxbind = ii  
а должно быть:  
maxb2 = Abs(b(ii, 4)): maxb2ind = ii  
И тогда все получается…  

  Скажите еще пожалуйста, вот эта строка  
maxb2 = Abs(b(ii, 4)): maxb2ind = ii  
это тоже самое что две строки:  
maxb2 = Abs(b(ii, 4))  
maxb2ind = ii  
?  

  И еще вопросик…  
For ii = 1 To UBound(b)  
Здесь не должно быть случаем  
For ii = 1 To (UBound(b)-1)  
а то он мне иногда пишет subscript out of range или что-то такое… )

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Да, двоеточие объединяет строки, так бывает удобнее группировать связанные действия.  
По поводу For ii = 1 To UBound(b) — посмотрите в отлfдчике, какое значение в этот момент принимает ii. Я думаю, что ii не выходит за границы, а причина в другой переменной, может перепутано типа b(i,1) вместо b(ii,1).

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Hugo! Спасите! )))    
Итак, все у меня готово, все фенечки сделаны…  
но есть какой-то внутренний косяк, и я понять совершенно не могу, почему он возникает…  
Точнее я понимаю почему он возникает, но с чем это может быть связано — понять совершенно не могу ((    
С заполнением желтых строк — все отлично. А вот заполнение зеленых строк зависит от положения искомой строки в базе данных. Почему-то получается, если требуемая строка является первой в рассматриваемом массиве, то скрипт выдает мне какую то чушь:  
Скрипт предполагает запоминание трех максимальных значений, и потом выборку из них оптимального, а в результатом почему то является четвертый максимум… (    

  Что поделать не знаю! Может примерно подскажите в каком направлении копаться?  
<EM><STRONG>Файл удален</STRONG> — велик размер — [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Файл взять успел.  
Кода много.  
Смотрю…

 

ситуация кажется немного прояснилась )  
Ошибка кроется где то на этапе «сравниваем суммы»…  

  Если убрать коэффициенты, из проверочных условий, то скрипт работает стабильно, независимо от положения строк…    
Но мне нужны эти коэффициенты.    
Суть как раз в том, что бы выбрать 3 максимальных значения из базы данных по одному условию, а затем по другим критериям из трёх максимальных выбрать искомое…

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

В 174 строке правильно? :)  
Вот это  
               If (0.1 * Abs(b(maxbind, 4)) + Abs(b(maxbind, 5)) + Abs(b(maxbind, 6))) > (0.1 * Abs(b(maxbm3ind, 4)) + Abs(b(maxbm3ind, 5)) + Abs(b(maxbm3ind, 6))) Then  

  там не надо maxbmind?

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Жесть (((    
это было проверено на 20 раз…потрачен целый день… ((( чертова невнимательность!  

  Спасибо Вам огромное!

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

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

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

Век живи век учись! хороший прием )    
у меня правда возникало желание заменить все эти «maxbm3ind…maxm3ind» на что-то более читаемое типа «x3…y3», но лень пересилила…видимо зря )    

  Сижу оцениваю результат, с тем что было выбрано раньше «ручным» методом! После проверки 100 значений ни одного сбоя, зато отлавливаются неучтенные опасные сочетания. Я в восторге! )

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

Красивый код получился, аккуратный такой :)  
А переменные мне и самому не нравятся, но так сначала начал — думал не о переменных, а об алгоритме, наспех буквы добавлял, чтоб отличались :)  
Так теперь заменой поменяйте.

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

нет уж! )    
пускай остаётся! как «наследие автора», на память! )

 

Natali

Пользователь

Сообщений: 26
Регистрация: 28.12.2012

#30

17.10.2010 08:54:50

А можно ли как нибудь огразиновать выборку по диаграмме? )  
В каждом конкретном случае у меня есть область, имеющая 6 нижних значений и 6 верхних.    
Надо что бы полученные нами N, My, Mz он сверял со значениями диаграммы, и если они попадают в эту область, он записывал идентификатор диаграммы, если не удовлетворяется, переходил к следующей.  

   Это вообще возможно? ) Диаграммы хитрые, как их вообще описать математически не понимаю…

Прикрепленные файлы

  • post_164633.jpg (74.64 КБ)

Под выпадающим списком понимается содержание в одной ячейке нескольких значений. Когда пользователь щелкает по стрелочке справа, появляется определенный перечень. Можно выбрать конкретное.

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

Создание раскрывающегося списка

Путь: меню «Данные» — инструмент «Проверка данных» — вкладка «Параметры». Тип данных – «Список».

Создание выпадающего списка.

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

  1. Вручную через «точку-с-запятой» в поле «Источник».
  2. Ввод значений.

  3. Ввести значения заранее. А в качестве источника указать диапазон ячеек со списком.
  4. Проверка вводимых значений.

  5. Назначить имя для диапазона значений и в поле источник вписать это имя.

Имя диапазона.
Раскрывающийся список.

Любой из вариантов даст такой результат.



Выпадающий список в Excel с подстановкой данных

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

  1. Выделяем диапазон для выпадающего списка. В главном меню находим инструмент «Форматировать как таблицу».
  2. Форматировать как таблицу.

  3. Откроются стили. Выбираем любой. Для решения нашей задачи дизайн не имеет значения. Наличие заголовка (шапки) важно. В нашем примере это ячейка А1 со словом «Деревья». То есть нужно выбрать стиль таблицы со строкой заголовка. Получаем следующий вид диапазона:
  4. Выпадающий список.

  5. Ставим курсор в ячейку, где будет находиться выпадающий список. Открываем параметры инструмента «Проверка данных» (выше описан путь). В поле «Источник» прописываем такую функцию:

Ввод значения в источник.

Протестируем. Вот наша таблица со списком на одном листе:

Список и таблица.

Добавим в таблицу новое значение «елка».

Добавлено значение елка.

Теперь удалим значение «береза».

Удалено значение береза.

Осуществить задуманное нам помогла «умная таблица», которая легка «расширяется», меняется.

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

Ввод данных из списка.

  1. Сформируем именованный диапазон. Путь: «Формулы» — «Диспетчер имен» — «Создать». Вводим уникальное название диапазона – ОК.
  2. Создание имени.

  3. Создаем раскрывающийся список в любой ячейке. Как это сделать, уже известно. Источник – имя диапазона: =деревья.
  4. Снимаем галочки на вкладках «Сообщение для ввода», «Сообщение об ошибке». Если этого не сделать, Excel не позволит нам вводить новые значения.
  5. Сообщение об ошибке.

  6. Вызываем редактор Visual Basic. Для этого щелкаем правой кнопкой мыши по названию листа и переходим по вкладке «Исходный текст». Либо одновременно нажимаем клавиши Alt + F11. Копируем код (только вставьте свои параметры).
  7. Private Sub Worksheet_Change(ByVal Target As Range)
     
    Dim lReply As Long
     
        If Target.Cells.Count > 1 Then Exit Sub
        If Target.Address = "$C$2" Then
         If IsEmpty(Target) Then Exit Sub
           If WorksheetFunction.CountIf(Range("Деревья"), Target) = 0 Then
              lReply = MsgBox("Добавить введенное имя " & _
                             Target & " в выпадающий список?", vbYesNo + vbQuestion)
              If lReply = vbYes Then
                  Range("Деревья").Cells(Range("Деревья").Rows.Count + 1, 1) = Target
              End If
           End If
         End If
    End Sub
     
  8. Сохраняем, установив тип файла «с поддержкой макросов».
  9. Сообщение об ошибке.

  10. Переходим на лист со списком. Вкладка «Разработчик» — «Код» — «Макросы». Сочетание клавиш для быстрого вызова – Alt + F8. Выбираем нужное имя. Нажимаем «Выполнить».

Макрос.

Когда мы введем в пустую ячейку выпадающего списка новое наименование, появится сообщение: «Добавить введенное имя баобаб в выпадающий список?».

Нажмем «Да» и добавиться еще одна строка со значением «баобаб».

Выпадающий список в Excel с данными с другого листа/файла

Когда значения для выпадающего списка расположены на другом листе или в другой книге, стандартный способ не работает. Решить задачу можно с помощью функции ДВССЫЛ: она сформирует правильную ссылку на внешний источник информации.

  1. Делаем активной ячейку, куда хотим поместить раскрывающийся список.
  2. Открываем параметры проверки данных. В поле «Источник» вводим формулу: =ДВССЫЛ(“[Список1.xlsx]Лист1!$A$1:$A$9”).

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

Как сделать зависимые выпадающие списки

Возьмем три именованных диапазона:

Три именованных диапазона.

Это обязательное условие. Выше описано, как сделать обычный список именованным диапазоном (с помощью «Диспетчера имен»). Помним, что имя не может содержать пробелов и знаков препинания.

  1. Создадим первый выпадающий список, куда войдут названия диапазонов.
  2. Список диапазонов.

  3. Когда поставили курсор в поле «Источник», переходим на лист и выделяем попеременно нужные ячейки.
  4. Таблица со списком.

  5. Теперь создадим второй раскрывающийся список. В нем должны отражаться те слова, которые соответствуют выбранному в первом списке названию. Если «Деревья», то «граб», «дуб» и т.д. Вводим в поле «Источник» функцию вида =ДВССЫЛ(E3). E3 – ячейка с именем первого диапазона.
  6. Второй раскрывающийся список.

    Выбор нескольких значений из выпадающего списка Excel

    Бывает, когда из раскрывающегося списка необходимо выбрать сразу несколько элементов. Рассмотрим пути реализации задачи.

    1. Создаем стандартный список с помощью инструмента «Проверка данных». Добавляем в исходный код листа готовый макрос. Как это делать, описано выше. С его помощью справа от выпадающего списка будут добавляться выбранные значения.
    2. Private Sub Worksheet_Change(ByVal Target As Range)
          On Error Resume Next
          If Not Intersect(Target, Range("Е2:Е9")) Is Nothing And Target.Cells.Count = 1 Then
              Application.EnableEvents = False
              If Len(Target.Offset(0, 1)) = 0 Then
                  Target.Offset(0, 1) = Target
              Else
                  Target.End(xlToRight).Offset(0, 1) = Target
              End If
              Target.ClearContents
              Application.EnableEvents = True
          End If
      End Sub
       
    3. Чтобы выбранные значения показывались снизу, вставляем другой код обработчика.
    4. Private Sub Worksheet_Change(ByVal Target As Range)
          On Error Resume Next
          If Not Intersect(Target, Range("Н2:К2")) Is Nothing And Target.Cells.Count = 1 Then
              Application.EnableEvents = False
              If Len(Target.Offset(1, 0)) = 0 Then
                  Target.Offset(1, 0) = Target
              Else
                  Target.End(xlDown).Offset(1, 0) = Target
              End If
              Target.ClearContents
              Application.EnableEvents = True
          End If
      End Sub
       
    5. Чтобы выбираемые значения отображались в одной ячейке, разделенные любым знаком препинания, применим такой модуль.

    6. Private Sub Worksheet_Change(ByVal Target As Range)
          On Error Resume Next
          If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
              Application.EnableEvents = False
              newVal = Target
              Application.Undo
              oldval = Target
              If Len(oldval) <> 0 And oldval <> newVal Then
                  Target = Target & "," & newVal
              Else
                  Target = newVal
              End If
              If Len(newVal) = 0 Then Target.ClearContents
              Application.EnableEvents = True
          End If
      End Sub

    Не забываем менять диапазоны на «свои». Списки создаем классическим способом. А всю остальную работу будут делать макросы.

    Выпадающий список с поиском

    1. На вкладке «Разработчик» находим инструмент «Вставить» – «ActiveX». Здесь нам нужна кнопка «Поле со списком» (ориентируемся на всплывающие подсказки).
    2. Вставить ActiveX.

    3. Щелкаем по значку – становится активным «Режим конструктора». Рисуем курсором (он становится «крестиком») небольшой прямоугольник – место будущего списка.
    4. Элемент ActiveX.

    5. Жмем «Свойства» – открывается перечень настроек.
    6. Свойства ActiveX.

    7. Вписываем диапазон в строку ListFillRange (руками). Ячейку, куда будет выводиться выбранное значение – в строку LinkedCell. Для изменения шрифта и размера – Font.

    Скачать пример выпадающего списка

    При вводе первых букв с клавиатуры высвечиваются подходящие элементы. И это далеко не все приятные моменты данного инструмента. Здесь можно настраивать визуальное представление информации, указывать в качестве источника сразу два столбца.

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

Как сделать связанный выпадающий список в «Эксель», зависящий от значения в соседней ячейке.

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

Для начала следует создать обыкновенный выпадающий список.

Для этого необходимо:

  • Войти во вкладку «Данные»;
  • Выбрать опцию «Проверка данных»;
  • Выбрать «Список»;
  • Указать диапазон, из которого будет выбираться выпадающий список или создать список прямо в появившемся поле через знак «;».

После этой процедуры следует записать макрос в документ.

Для записи макроса следует:

  • Открыть вкладку «Разработчик» ( Если вкладка отключена, включите ее в разделе Файл=> Параметры=> Настройка Ленты);

Разработчик

  • Во вкладке «Разработчик» выбрать кнопку «Просмотр кода»;
  • В открывшееся окно записать макрос;

Макрос

  • Закрыть окно с макросом.

Давайте рассмотрим несколько макросов с выпадающими списками.

Первый макрос со смещением списка в сторону (горизонтально).

Горизонтальный список
Текст макроса:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range(«B2:B10»)) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
If Len(Target.Offset(0, 1)) = 0 Then
Target.Offset(0, 1) = Target
Else
Target.End(xlToRight).Offset(0, 1) = Target
End If
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Необходимо обратить внимание, что в строке :
If Not Intersect(Target, Range(«B1:B10»)) Is Nothing And Target.Cells.Count = 1 Then
Значения («B1:B10»)— это диапазон в пределах которого будет работать выпадающий список.
Аналогичным образом можно создать выпадающий список со смещением вниз и выпадающий список, записывающий в ячейку несколько значений через знак табуляции или пробел.

Макрос выпадающего списка со смещением вниз:

Вертикальный список
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range(«C2:F2»)) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
If Len(Target.Offset(1, 0)) = 0 Then
Target.Offset(1, 0) = Target
Else
Target.End(xlDown).Offset(1, 0) = Target
End If
Target.ClearContents
Application.EnableEvents = True
End If
End Sub

Макрос выпадающего списка с внесением нескольких значений в одну ячейку:

Накопительный список
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range(«B2:B5»)) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
newVal = Target
Application.Undo
oldval = Target
If Len(oldval) <> 0 And oldval <> newVal Then
Target = Target & «//» & newVal
Else
Target = newVal
End If
If Len(newVal) = 0 Then Target.ClearContents
Application.EnableEvents = True
End If
End Sub

В строке If Not Intersect(Target, Range(«B2:B5»)) Is Nothing And Target.Cells.Count = 1 Then
указывается диапазон действия макроса.
В строке
Target = Target & «//» & newVal
указывается разделитель «//». Его можно заменить на любой знак препинания, текст или поставить пробел.

Скриншот формы ввода (выпадающий список с поиском)

Надстройка для облегчения ввода значений в ячейку Excel

Автор: nerv
Last Update: 27/03/2012

Вам часто приходится заниматься заполнением электронных таблиц, долго и муторно выбирать варианты из выпадающих списков?

А, может, иметь дело с одними теми же, но не структурированными данными?

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

Как это работает:

По нажатию Ctrl+Enter рядом с выделенной ячейкой появляется список, который позволяет не только выбирать, но и производить поиск по интересующим Вас данным.

Посмотрим, что он умеет:

  • Не содержит повторов (уникальный). Легко выявить однотипные данные;
  • Отсортирован по возрастанию. Возможность быстро найти то, что нужно;
  • После вызова сразу готов к поиску/выбору из списка. Лишние движения ни к чему;
  • Позволяет искать с использованием специальных подстановочных символов (*,?,~ и т.п.);
  • Осуществлять быстрый поиск по «шаблону». Если ячейка, из которой был вызван список, содержит информацию, поиск будет произведен по ней;
  • Появляется рядом с текущей/активной ячейкой и не «убегает» за пределы экрана;
  • Навигация привычными стандартными клавишами: Up [Вверх], Down [Вниз], Page Up [На страницу Вверх ], Page Down [На страницу вниз];
  • Корректная работа со всеми типами данных: строки, даты, числа;
  • Обработка ошибок формул листа. Никаких пустых строк в списке;
  • Обработка защиты ячеек листа. В защищенные ячейки ввод запрещен;
  • Информация об общем количестве списка и найденных по запросу элементах;
  • Быстрый вызов по нажатию Ctrl+Enter;
  • Быстрое закрытие: клавиша Esc;
  • Быстрый ввод клавишей Enter

Помимо всего вышеперечисленного, позволяет сэкономить на размере файла за счет формирования списка «на лету», который создается в разы быстрее, если данные упорядочены или частично упорядочены по возрастанию.

Отличия версии 1.6 от 1.5:

  • новая, более мощная/быстрая процедура сортировки;
  • переход после ввода на следующую ячейку (в зависимости от установок Excel);

Добавлены настройки:

  • использования и формирования списка (подробнее во вложении «how to use»);
  • поиска с учетом регистра и без него;
  • маски поиска;
  • заголовков.
  • 160117 просмотров

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Поиск какого-либо значения в ячейках Excel довольно часто встречающаяся задача при программировании какого-либо макроса. Решить ее можно разными способами. Однако, в разных ситуациях использование того или иного способа может быть не оправданным. В данной статье я рассмотрю 2 наиболее распространенных способа.

Поиск перебором значений

Довольно простой в реализации способ. Например, найти в колонке «A» ячейку, содержащую «123» можно примерно так:

Sheets("Данные").Select
For y = 1 To Cells.SpecialCells(xlLastCell).Row
    If Cells(y, 1) = "123" Then
        Exit For
    End If
Next y
MsgBox "Нашел в строке: " + CStr(y)

Минусами этого так сказать «классического» способа являются: медленная работа и громоздкость. А плюсом является его гибкость, т.к. таким способом можно реализовать сколь угодно сложные варианты поиска с различными вычислениями и т.п.

Поиск функцией Find

Гораздо быстрее обычного перебора и при этом довольно гибкий. В простейшем случае, чтобы найти в колонке A ячейку, содержащую «123» достаточно такого кода:

Sheets("Данные").Select
Set fcell = Columns("A:A").Find("123")
If Not fcell Is Nothing Then
    MsgBox "Нашел в строке: " + CStr(fcell.Row)
End If

Вкратце опишу что делают строчки данного кода:
1-я строка: Выбираем в книге лист «Данные»;
2-я строка: Осуществляем поиск значения «123» в колонке «A», результат поиска будет в fcell;
3-я строка: Если удалось найти значение, то fcell будет содержать Range-объект, в противном случае — будет пустой, т.е. Nothing.

Полностью синтаксис оператора поиска выглядит так:

Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

What — Строка с текстом, который ищем или любой другой тип данных Excel

After — Ячейка, после которой начать поиск. Обратите внимание, что это должна быть именно единичная ячейка, а не диапазон. Поиск начинается после этой ячейки, а не с нее. Поиск в этой ячейке произойдет только когда весь диапазон будет просмотрен и поиск начнется с начала диапазона и до этой ячейки включительно.

LookIn — Тип искомых данных. Может принимать одно из значений: xlFormulas (формулы), xlValues (значения), или xlNotes (примечания).

LookAt — Одно из значений: xlWhole (полное совпадение) или xlPart (частичное совпадение).

SearchOrder — Одно из значений: xlByRows (просматривать по строкам) или xlByColumns (просматривать по столбцам)

SearchDirection — Одно из значений: xlNext (поиск вперед) или xlPrevious (поиск назад)

MatchCase — Одно из значений: True (поиск чувствительный к регистру) или False (поиск без учета регистра)

MatchByte — Применяется при использовании мультибайтных кодировок: True (найденный мультибайтный символ должен соответствовать только мультибайтному символу) или False (найденный мультибайтный символ может соответствовать однобайтному символу)

SearchFormat — Используется вместе с FindFormat. Сначала задается значение FindFormat (например, для поиска ячеек с курсивным шрифтом так: Application.FindFormat.Font.Italic = True), а потом при использовании метода Find указываем параметр SearchFormat = True. Если при поиске не нужно учитывать формат ячеек, то нужно указать SearchFormat = False.

Чтобы продолжить поиск, можно использовать FindNext (искать «далее») или FindPrevious (искать «назад»).

Примеры поиска функцией Find

Пример 1: Найти в диапазоне «A1:A50» все ячейки с текстом «asd» и поменять их все на «qwe»

With Worksheets(1).Range("A1:A50")
  Set c = .Find("asd", LookIn:=xlValues)
  Do While Not c Is Nothing
    c.Value = "qwe"
    Set c = .FindNext(c)
  Loop
End With

Обратите внимание: Когда поиск достигнет конца диапазона, функция продолжит искать с начала диапазона. Таким образом, если значение найденной ячейки не менять, то приведенный выше пример зациклится в бесконечном цикле. Поэтому, чтобы этого избежать (зацикливания), можно сделать следующим образом:

Пример 2: Правильный поиск значения с использованием FindNext, не приводящий к зацикливанию.

With Worksheets(1).Range("A1:A50")
  Set c = .Find("asd", lookin:=xlValues)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
      c.Font.Bold = True
      Set c = .FindNext(c)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If
End With

В ниже следующем примере используется другой вариант продолжения поиска — с помощью той же функции Find с параметром After. Когда найдена очередная ячейка, следующий поиск будет осуществляться уже после нее. Однако, как и с FindNext, когда будет достигнут конец диапазона, Find продолжит поиск с его начала, поэтому, чтобы не произошло зацикливания, необходимо проверять совпадение с первым результатом поиска.

Пример 3: Продолжение поиска с использованием Find с параметром After.

With Worksheets(1).Range("A1:A50")
  Set c = .Find("asd", lookin:=xlValues)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
      c.Font.Bold = True
      Set c = .Find("asd", After:=c, lookin:=xlValues)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If
End With

Следующий пример демонстрирует применение SearchFormat для поиска по формату ячейки. Для указания формата необходимо задать свойство FindFormat.

Пример 4: Найти все ячейки с шрифтом «курсив» и поменять их формат на обычный (не «курсив»)

lLastRow = Cells.SpecialCells(xlLastCell).Row
lLastCol = Cells.SpecialCells(xlLastCell).Column
Application.FindFormat.Font.Italic = True
With Worksheets(1).Range(Cells(1, 1), Cells(lLastRow, lLastCol))
  Set c = .Find("", SearchFormat:=True)
  Do While Not c Is Nothing
    c.Font.Italic = False
    Set c = .Find("", After:=c, SearchFormat:=True)
  Loop
End With

Примечание: В данном примере намеренно не используется FindNext для поиска следующей ячейки, т.к. он не учитывает формат (статья об этом: https://support.microsoft.com/ru-ru/kb/282151)

Коротко опишу алгоритм поиска Примера 4. Первые две строки определяют последнюю строку (lLastRow) на листе и последний столбец (lLastCol). 3-я строка задает формат поиска, в данном случае, будем искать ячейки с шрифтом Italic. 4-я строка определяет область ячеек с которой будет работать программа (с ячейки A1 и до последней строки и последнего столбца). 5-я строка осуществляет поиск с использованием SearchFormat. 6-я строка — цикл пока результат поиска не будет пустым. 7-я строка — меняем шрифт на обычный (не курсив), 8-я строка продолжаем поиск после найденной ячейки.

Хочу обратить внимание на то, что в этом примере я не стал использовать «защиту от зацикливания», как в Примерах 2 и 3, т.к. шрифт меняется и после «прохождения» по всем ячейкам, больше не останется ни одной ячейки с курсивом.

Свойство FindFormat можно задавать разными способами, например, так:

With Application.FindFormat.Font 
  .Name = "Arial" 
  .FontStyle = "Regular" 
  .Size = 10 
End With

Поиск последней заполненной ячейки с помощью Find

Следующий пример — применение функции Find для поиска последней ячейки с заполненными данными. Использованные в Примере 4 SpecialCells находит последнюю ячейку даже если она не содержит ничего, но отформатирована или в ней раньше были данные, но были удалены.

Пример 5: Найти последнюю колонку и столбец, заполненные данными

Set c = Worksheets(1).UsedRange.Find("*", SearchDirection:=xlPrevious)
If Not c Is Nothing Then
  lLastRow = c.Row: lLastCol = c.Column 
Else
  lLastRow = 1: lLastCol = 1
End If
MsgBox "lLastRow=" & lLastRow & " lLastCol=" & lLastCol

В этом примере используется UsedRange, который так же как и SpecialCells возвращает все используемые ячейки, в т.ч. и те, что были использованы ранее, а сейчас пустые. Функция Find ищет ячейку с любым значением с конца диапазона.

Поиск по шаблону (маске)

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

Пример 6: Выделить красным шрифтом ячейки, в которых текст начинается со слова из 4-х букв, первая и последняя буквы «т», при этом после этого слова может следовать любой текст.

With Worksheets(1).Cells
  Set c = .Find("т??т*", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
      c.Font.Color = RGB(255, 0, 0)
      Set c = .FindNext(c)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If
End With

Для поиска функцией Find по маске (шаблону) можно применять символы:
* — для обозначения любого количества любых символов;
? — для обозначения одного любого символа;
~ — для обозначения символов *, ? и ~. (т.е. чтобы искать в тексте вопросительный знак, нужно написать ~?, чтобы искать именно звездочку (*), нужно написать ~* и наконец, чтобы найти в тексте тильду, необходимо написать ~~)

Поиск в скрытых строках и столбцах

Для поиска в скрытых ячейках нужно учитывать лишь один нюанс: поиск нужно осуществлять в формулах, а не в значениях, т.е. нужно использовать LookIn:=xlFormulas

Поиск даты с помощью Find

Если необходимо найти текущую дату или какую-то другую дату на листе Excel или в диапазоне с помощью Find, необходимо учитывать несколько нюансов:

  • Тип данных Date в VBA представляется в виде #[месяц]/[день]/[год]#, соответственно, если необходимо найти фиксированную дату, например, 01 марта 2018 года, необходимо искать #3/1/2018#, а не «01.03.2018»
  • В зависимости от формата ячеек, дата может выглядеть по-разному, поэтому, чтобы искать дату независимо от формата, поиск нужно делать не в значениях, а в формулах, т.е. использовать LookIn:=xlFormulas

Приведу несколько примеров поиска даты.

Пример 7: Найти текущую дату на листе независимо от формата отображения даты.

d = Date
Set c = Cells.Find(d, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not c Is Nothing Then
  MsgBox "Нашел"
Else
  MsgBox "Не нашел"
End If

Пример 8: Найти 1 марта 2018 г.

d = #3/1/2018#
Set c = Cells.Find(d, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not c Is Nothing Then
  MsgBox "Нашел"
Else
  MsgBox "Не нашел"
End If

Искать часть даты — сложнее. Например, чтобы найти все ячейки, где месяц «март», недостаточно искать «03» или «3». Не работает с датами так же и поиск по шаблону. Единственный вариант, который я нашел — это выбрать формат в котором месяц прописью для ячеек с датами и искать слово «март» в xlValues.

Тем не менее, можно найти, например, 1 марта независимо от года.

Пример 9: Найти 1 марта любого года.

d = #3/1/1900#
Set c = Cells.Find(Format(d, "m/d/"), LookIn:=xlFormulas, LookAt:=xlPart)
If Not c Is Nothing Then
  MsgBox "Нашел"
Else
  MsgBox "Не нашел"
End If

Понравилась статья? Поделить с друзьями:
  • Excel макрос выбранная ячейка
  • Excel макрос вставки формул
  • Excel макрос вставки пустых строк
  • Excel макрос вставить формулу в ячейку
  • Excel макрос вставить текст в ячейку