ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Поиск нескольких слов в ячейке
25 сообщений из 32, страница 1 из 2
  1  все
Поиск нескольких слов в ячейке
    #37444147
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
Подскажите, пож-та, как можно оптимизировать поиск определенных ячеек по столбцу B с помощью макроса. Критерий поиска - наличие в ячейке 4-х нужных слов/выражений (в данном случае "Узлы", "трубопроводов", "32 мм", 4,0 мм". Если ячейка найдена, то значение из столбца D копируется в столбец F.
У меня пока вот так только получается, но макрос какой-то неудобный и громоздкий в редактировании (если его переделывать для других критериев поиска).

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub Узлы_трубопроводов()
Application.ScreenUpdating = False
Dim iLastRow As Long
iLastRow = Cells(Rows.Count,  2 ).End(xlUp).Row
   For i =  1  To iLastRow
      If InStr( 1 , Cells(i,  2 ).Text, "Узлы") >  0  And InStr( 1 , Cells(i,  2 ).Text, "трубопроводов") >  0  And InStr( 1 , Cells(i,  2 ).Text, "32 мм") >  0  And InStr( 1 , Cells(i,  2 ).Text, "4,0 мм") >  0  And Cells(i,  3 ) = "т" Then
        Cells(i,  6 ) = Cells(i,  4 )
         
      End If
      
   Next
End Sub
...
Рейтинг: 0 / 0
16.09.2011, 18:39
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37444207
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Zerat,
так редактировать будет несколько удобнее.
 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
Option Explicit

Sub pipelines_knots()
' используется объект ADODB.Connection

Const S_TABLE$ = "[123$A5:F100]"    ' "таблица" с данными

Dim scn$, sq$, s$, st$
Dim k%
Dim cn, a

' массив слов для поиска
a = Array( _
"Узлы", _
"трубопроводов", _
"32 мм", _
"4,0 мм")

' сборка запроса -->
s = ""
For k = LBound(a) To UBound(a)
    s = s & " AND F2 Like '%" & a(k) & "%'"
Next k
Erase a

sq = "update " & S_TABLE & " set F6=F4 where 1=1" & s
sq = sq & " AND F3='т'" '<-- это условие несколько выбивается из общего "орнамента"
' сборка запроса <--


' создание ADO подключения и выполнение запроса -->
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Mode=ReadWrite;Data Source=" _
    & ThisWorkbook.FullName _
    & ";Extended Properties='Excel 8.0;HDR=No;IMEX=2'"

Set cn = CreateObject("adodb.connection")

cn.Open scn
cn.Execute sq
' создание ADO подключения и выполнение запроса <--


' no comment
cn.Close
Set cn = Nothing

End Sub
Минус этого варианта - число в столбце F сохраняется как текст.
...
Рейтинг: 0 / 0
16.09.2011, 19:29
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37444215
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Зато плюсы варианта с запросом - можно задавать исходный массив из ячеек отдельного листа; задать условия соеденения не только AND; прогнать процедуру циклом по нескольким условиям сделав отбор, например, сразу в несколько столбцов, или делать обработку только "отмеченных" условий...
...
Рейтинг: 0 / 0
16.09.2011, 19:34
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37444218
Михаил Ч.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Михаил Ч.
Гость
А может формула сойдет?
для ячейки F5 формула массива (вводится нажатим Ctrl+Shift+Enter):
Код: plaintext
=ЕСЛИ(И(ЕЧИСЛО(ПОИСК({"Узлы":"трубопроводов":"32 мм":"4,0 мм"};B5)));D5;"")
и копируем вниз
...
Рейтинг: 0 / 0
16.09.2011, 19:34
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37444229
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
 
OFFAndreTM,авторЗато плюсы ...
И в итоге получим реализауию расширенного фильтра
...
Рейтинг: 0 / 0
16.09.2011, 19:50
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37444287
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
скукотища,

Ага... на это и был намёк.
...
Рейтинг: 0 / 0
16.09.2011, 20:54
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445230
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
скукотищаZerat,
так редактировать будет несколько удобнее.
Минус этого варианта - число в столбце F сохраняется как текст.

Спасибо за код! Правда для меня не понятен принцип его действия, но главное что он работает.
Не понятно, где в коде можно менять ячейки куда нужно скопировать числа, т.е. допустим не Cells(i, 6) = Cells(i, 4), а Cells(i, 8) = Cells(i, 4)?
...
Рейтинг: 0 / 0
18.09.2011, 12:05
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445231
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
Михаил Ч.А может формула сойдет?
для ячейки F5 формула массива (вводится нажатим Ctrl+Shift+Enter):
Код: plaintext
=ЕСЛИ(И(ЕЧИСЛО(ПОИСК({"Узлы":"трубопроводов":"32 мм":"4,0 мм"};B5)));D5;"")
и копируем вниз

Спасибо, но слишком большие таблицы нужно обрабатывать. Не очень удобно формулы протягивать.
...
Рейтинг: 0 / 0
18.09.2011, 12:06
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445446
скуоктища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скуоктища
Гость
Zerat,
Не понятно, где в коде можно менять ячейки куда нужно скопировать числа, т.е. допустим не Cells(i, 6) = Cells(i, 4), а Cells(i, 8) = Cells(i, 4)?
Код: plaintext
1.
2.
' здесь
sq = "update " & S_TABLE & " set F6=F4 where 1=1" & s ' эквивалент Cells(i, 6) = Cells(i, 4)
Код: plaintext
1.
2.
' чтобы получить эквивалент Cells(i, 8) = Cells(i, 4), - меняем F6 на F8
sq = "update " & S_TABLE & " set F8=F4 where 1=1" & s '
...
Рейтинг: 0 / 0
18.09.2011, 19:05
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445521
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
скуоктища
Код: plaintext
1.
2.
' здесь
sq = "update " & S_TABLE & " set F6=F4 where 1=1" & s ' эквивалент Cells(i, 6) = Cells(i, 4)
Код: plaintext
1.
2.
' чтобы получить эквивалент Cells(i, 8) = Cells(i, 4), - меняем F6 на F8
sq = "update " & S_TABLE & " set F8=F4 where 1=1" & s '


так я пробовал, но он выдает ошибку - ругается на строку

Код: plaintext
1.
cn.Execute sq
...
Рейтинг: 0 / 0
18.09.2011, 20:51
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445525
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Zerat,
таблицу с данными тоже надо изменить

Код: plaintext
1.
2.
' было: 6 полей
Const S_TABLE$ = "[123$A5:F100]"    ' "таблица" с данными
Код: plaintext
1.
2.
' изменить на: 
Const S_TABLE$ = "[123$A5:H100]"    ' "таблица" с данными
'  8  полей
...
Рейтинг: 0 / 0
18.09.2011, 20:56
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445541
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
скукотища,
все равно ругается на ту же строчку
...
Рейтинг: 0 / 0
18.09.2011, 21:16
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445545
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Zerat,
1. какими именно словами ругается ?
2. поставьте в поцедуре точку останова на строке
Код: plaintext
1.
cn.Execute sq
и посмотрите, чему у Вас равно sq
...
Рейтинг: 0 / 0
18.09.2011, 21:21
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445548
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
...должно быть
Код: plaintext
update [ 123 $A5:H100] set F8=F4 where  1 = 1  AND F2 Like '%Узлы%' AND F2 Like '%трубопроводов%' ... AND AND F3='т'
вместо многоточия ещё несколько "AND F2 Like "
...
Рейтинг: 0 / 0
18.09.2011, 21:26
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37445553
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Zerat,
ошибка: "отсутствует значение для одного или нескольких требуемых параметров"
решение: записать хоть что-нибудь в любую строку столбца H
...
Рейтинг: 0 / 0
18.09.2011, 21:36
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37446891
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
скукотища,
в итоге получается сложнее, чем у меня. Хотелось бы что-н. попроще. А то уходим в дебри.
...
Рейтинг: 0 / 0
19.09.2011, 19:11
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37447067
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Zerat,
увы и ах. У меня проще никогда не получалось :(
Может для поиска нужных строк Вам подойдёт расширенный фильтр ?
В меру гибок, достаточно проворен.
...
Рейтинг: 0 / 0
19.09.2011, 21:51
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37447233
R Dmitry
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
R Dmitry
Участник
сделал из двух :)) будет работать шустро....

 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
Sub Узлы_трубопроводов()
Application.ScreenUpdating = False

Dim iLastRow As Long, arr(), a(), c(), i&, j&, bl As Boolean
a = Array( _
"Узлы", _
"трубопроводов", _
"32 мм", _
"4,0 мм")

iLastRow = Cells(Rows.Count,  2 ).End(xlUp).Row
arr = Range("a1:f" & iLastRow).Value
ReDim c( 1  To iLastRow,  1  To  1 )
   For i =  1  To UBound(arr)
   If arr(i,  3 ) = "т" Then
   bl = False
        For j =  0  To UBound(a)
              If InStr( 1 , arr(i,  2 ), a(j)) >  0  Then bl = True Else bl = False: Exit For
         Next
        If bl Then c(i,  1 ) = arr(i,  4 )
      End If
    Next
    Range("f1:f" & iLastRow).Value = c
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
20.09.2011, 01:54
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37448359
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
R Dmitry,
спасибо большое! Очень классно получилось. Хотелось именно чего-н. такого универсального. Т.е. здесь можно и количество слов для поиска разное вводить, и в разные столбцы результаты копировать.

Вот еще вопрос. Захотелось немного адаптировать код: т.е. допустим если единица измерения (3-й столбец) "т" - то результаты копировать в столбец G, а если "м" - то в столбец H. Для этого добавил Else и повторил ту же процедуру.
У меня вот что получилось:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
Sub Узлы_трубопроводов_3()
Application.ScreenUpdating = False

Dim iLastRow As Long, arr(), a(), c(), d(), i&, j&, bl As Boolean
a = Array( _
"Узлы", _
"трубопроводов", _
"32 мм")

iLastRow = Cells(Rows.Count,  2 ).End(xlUp).Row
arr = Range("a1:d" & iLastRow).Value
ReDim c( 1  To iLastRow,  1  To  1 )
ReDim d( 1  To iLastRow,  1  To  1 )
   For i =  1  To UBound(arr)
     If arr(i,  3 ) = "т" Then
       bl = False
          For j =  0  To UBound(a)
              If InStr( 1 , arr(i,  2 ), a(j)) >  0  Then bl = True Else bl = False: Exit For
          Next
             If bl Then c(i,  1 ) = arr(i,  4 )
           Else
             If arr(i,  3 ) = "м" Then
                 bl = False
                    For j =  0  To UBound(a)
                        If InStr( 1 , arr(i,  2 ), a(j)) >  0  Then bl = True Else bl = False: Exit For
                    Next
               If bl Then d(i,  1 ) = arr(i,  4 )
             End If
      End If
    
      Range("g1:g" & iLastRow).Value = c
      Range("h1:h" & iLastRow).Value = d
    Next
    Application.ScreenUpdating = True
End Sub


Код работает, но кажется он сам по себе громоздкий)
...
Рейтинг: 0 / 0
20.09.2011, 16:19
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37448557
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Zerat,
наверное снова усложняю...
 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
Sub Узлы_трубопроводов_3()
Application.ScreenUpdating = False

Dim iLastRow As Long, arr(), a(), c(), i&, j&, bl As Boolean
Dim s$, k&

a = Array( _
"Узлы", _
"трубопроводов", _
"32 мм")

iLastRow = Cells(Rows.Count,  2 ).End(xlUp).Row
arr = Range("a1:d" & iLastRow).Value
c = Range("g1:h" & iLastRow).Value

   For i =  1  To UBound(arr)
	s = arr(i,  3 )
	if s = "т" then
	    k =  1 
	elseif s = "м" then
	    k =  2 
	else
	    k =  0 
	end if
	
	if k >  0  then
	  bl = False
    	  For j =  0  To UBound(a)
    	      If InStr( 1 , arr(i,  2 ), a(j)) >  0  Then bl = True Else bl = False: Exit For
	  Next j
          If bl Then c(i, k) = arr(i,  4 )
	end if
    Next

Range("g1:h" & iLastRow).Value = c

Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
20.09.2011, 17:46
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37448972
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Да чего там усложнять...

В принципе, ТСу достаточно было изучить, как правильно формировать SQL-запрос. Его ведь можно сформировать и прямо в любой ячейке, а скрипту просто передать параметром...
...
Рейтинг: 0 / 0
20.09.2011, 22:45
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37449076
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
AndreTMДа чего там усложнять...Вроде бы всё просто, как двери. Но на грабли я-таки наступил. При попытке выполнить запрос на обновление ячеек, не входящих в .UsedRange.
...
Рейтинг: 0 / 0
21.09.2011, 04:39
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37449088
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Zerat
Гость
скукотищаZerat,
наверное снова усложняю...


спасибо, получилось еще более универсально. Т.е. можно теперь искать по нескольким условиям в различных столбцах.
...
Рейтинг: 0 / 0
21.09.2011, 07:10
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37450908
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Ну а такой вариант?
Есть пара условностей - последовательность слов должна соблюдаться, и отбор идёт по "т" или любое другое значение:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub tt()
    Dim a, i&
    a = [b3].CurrentRegion.Value
    ReDim b( 1  To UBound(a),  1  To  2 )
    For i =  1  To UBound(a)
        If a(i,  2 ) Like "Узлы*трубопроводов*32 мм*4,0*" Then b(i, -(a(i,  3 ) = "т") +  1 ) = a(i,  4 )
    Next
    [b3].CurrentRegion.Columns( 1 ).Offset(,  6 ).Resize(,  2 ) = b
End Sub

Отбор по "т" можно и нарастить добавлением переменных, но не хотелось усложнять.
...
Рейтинг: 0 / 0
22.09.2011, 01:18
| Ответить | Цитировать | Написать  
Поиск нескольких слов в ячейке
    #37451033
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Ну или если так разбить по словам (можно и Instr() использовать), то легко поменять на анализ по разным словам и в разных столбцах.
И порядок слов уже роли не играет.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Sub ttt()
    Dim a, i&
    a = [b3].CurrentRegion.Value
    ReDim b( 1  To UBound(a),  1  To  2 )
    For i =  1  To UBound(a)
        If a(i,  2 ) Like "*Узлы*" Then
        If a(i,  2 ) Like "*трубопроводов*" Then
        If a(i,  2 ) Like "*32 мм*" Then
        If a(i,  2 ) Like "*4,0*" Then
            b(i, -(a(i,  3 ) = "т") +  1 ) = a(i,  4 )
        End If
        End If
        End If
        End If
    Next
    [b3].CurrentRegion.Columns( 1 ).Offset(,  6 ).Resize(,  2 ) = b
End Sub
...
Рейтинг: 0 / 0
22.09.2011, 09:21
| Ответить | Цитировать | Написать  
25 сообщений из 32, страница 1 из 2
  1  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Поиск нескольких слов в ячейке
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=37444147&tid=2176257]:
 0ms
get settings:
 5ms
get forum list:
 11ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 129ms
get topic data:
 6ms
get forum data:
 1ms
get page messages:
 34ms
get tp. blocked users:
 1ms
others: 204ms
total:  395ms
созд. / загр.: 395ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]