Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Поиск нескольких слов в ячейке / 25 сообщений из 32, страница 1 из 2
  1  все
16.09.2011, 18:39
    #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, 19:29
    #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:34
    #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:50
    #37444229
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
 
OFFAndreTM,авторЗато плюсы ...
И в итоге получим реализауию расширенного фильтра
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
16.09.2011, 20:54
    #37444287
AndreTM
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
скукотища,

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

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

Спасибо, но слишком большие таблицы нужно обрабатывать. Не очень удобно формулы протягивать.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.09.2011, 19:05
    #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, 20:51
    #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:56
    #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, 21:16
    #37445541
Zerat
Zerat
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
скукотища,
все равно ругается на ту же строчку
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.09.2011, 21:21
    #37445545
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
Zerat,
1. какими именно словами ругается ?
2. поставьте в поцедуре точку останова на строке
Код: plaintext
1.
cn.Execute sq
и посмотрите, чему у Вас равно sq
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.09.2011, 21:26
    #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:36
    #37445553
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
Zerat,
ошибка: "отсутствует значение для одного или нескольких требуемых параметров"
решение: записать хоть что-нибудь в любую строку столбца H
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.09.2011, 19:11
    #37446891
Zerat
Zerat
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
скукотища,
в итоге получается сложнее, чем у меня. Хотелось бы что-н. попроще. А то уходим в дебри.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.09.2011, 21:51
    #37447067
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
Zerat,
увы и ах. У меня проще никогда не получалось :(
Может для поиска нужных строк Вам подойдёт расширенный фильтр ?
В меру гибок, достаточно проворен.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
20.09.2011, 01:54
    #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, 16:19
    #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, 17:46
    #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, 22:45
    #37448972
AndreTM
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск нескольких слов в ячейке
Да чего там усложнять...

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


спасибо, получилось еще более универсально. Т.е. можно теперь искать по нескольким условиям в различных столбцах.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.09.2011, 01:18
    #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, 09:21
    #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
| Ответить | Цитировать | Написать  
  1  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Поиск нескольких слов в ячейке / 25 сообщений из 32, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 548ms
Закрыть
start [/forum/topic.php?fid=61&mobile=1&tid=2176257]:
 0ms
get settings:
 8ms
get forum list:
 22ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 185ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 67ms
get tp. blocked users:
 2ms
others: 245ms
total:  548ms
x
x
Закрыть


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