powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Поиск нескольких слов в ячейке
7 сообщений из 32, страница 2 из 2
Поиск нескольких слов в ячейке
    #37535061
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый вечер.
Возникла необходимость добавить еще условие для поиска.
Критерии поиска – не только наличие в ячейке искомых слов, но и отсутствие некоторых слов. Т.е. как вписать в код массив, в который можно будет вводить слова, которых не должно быть в найденной ячейке. Например, слов "4 мм", "5 мм"

Код: 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
Поиск нескольких слов в ячейке
    #37535065
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Zerat,

ну предлагал же я делать запросом - так нет, надо было свою логику завести в тупик...
...
Рейтинг: 0 / 0
Поиск нескольких слов в ячейке
    #37535076
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
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.
'+
dim a_minus()

a_minus = array( _
"4 мм", _
"5 мм")

' {skipped}
	if k >  0  then
' NB! проверки на не_вхождение/вхождение можно местами менять
	  bl = False
    	  For j =  0  To UBound(a_minus)
    	      If InStr( 1 , arr(i,  2 ), a(j)) =  0  Then bl = True Else bl = False: Exit For
	  Next j
If bl 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
	end if
    Next

' {skipped}
ЗЫ: а запросами, действительно, будет проще... Но потом ;)
...
Рейтинг: 0 / 0
Поиск нескольких слов в ячейке
    #37535339
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо, скукотища. Я вставил ваш фрагмент в код. Но ситуация получилась обратная-копируются ячейки не только по совпадению в первом массиве, но и по совпадению во втором. Т.е. если есть 4,0 мм (содержится в массиве a_minus) то он копируется в другой столбец, хотя, наоборот, не должен.



Код: 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.
48.
49.
50.
51.
52.
53.
Sub Узлы_трубопроводов_4()
Application.ScreenUpdating = False

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

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
    
a_minus = Array( _
"4 мм", _
"5 мм")

' {skipped}
    If k >  0  Then
' NB! проверки на не_вхождение/вхождение можно местами менять
      bl = False
          For j =  0  To UBound(a_minus)
              If InStr( 1 , arr(i,  2 ), a_minus(j)) =  0  Then bl = True Else bl = False: Exit For
      Next j
If bl 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
    End If
    Next

' {skipped}


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

Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Поиск нескольких слов в ячейке
    #37535479
Zerat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AndreTM,
я не знаю как это сделать)
...
Рейтинг: 0 / 0
Поиск нескольких слов в ячейке
    #37536056
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
То есть количество кода растёт, а понимания его как не было, так и не ...
Скукотища , я же незря предложил научить человека синтаксису SQL-запросов...
...
Рейтинг: 0 / 0
Поиск нескольких слов в ячейке
    #37536263
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Zerat,
Т.е. если есть 4,0 мм (содержится в массиве a_minus) то он копируется в другой столбец, хотя, наоборот, не должен.
Код: plaintext
1.
2.
a_minus = Array( _
"4 мм", _
"5 мм")

"4,0 мм" != "4 мм"
...
Рейтинг: 0 / 0
7 сообщений из 32, страница 2 из 2
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Поиск нескольких слов в ячейке
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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