Поиск по неполному содержанию

[Dimchiko]

Коллеги, добрый день.
Столкнулся с такой проблемой: при поиске макросом ячейки с текстовым содержанием надо обеспечить точное совпадение.
Например, ищу в столбце слово "Замеры" и макрос находит именно "Замеры", но не находит "Замеры " или "замеры".
Можно ли как-то искать иначе? Например, искать "амеры", игнорируя все, что перед и все, что после?

[Serge 007]

искать "амеры", игнорируя все, что перед и все, что после?

Код Выделить Развернуть

Sub FindPart()
    For Each rR In Range("a1:a10")
        If rR Like "*амеры*" Then MsgBox rR
    Next rR
End Sub

[Dimchiko]

РАБОТАЕТ!!!!
СПАСИБО ГРОМАДНОЕ!!!!!!!!!!!!!

[Hugo121]

Ну в данном случае можно просто навесить

Код Выделить Развернуть

lcase(trim("Замеры "))="замеры"

[Serge 007]

Игорь, или использовать функции листа ВПР(_)/ПОИСКПОЗ()
Они не различают регистр и позволяют искать "со звездочкой"

Недавно тема такая была:
https://forum.msexcel.ru/index.php?topic=12201.0 Учитывать заглавные буквы при использовании ВПР

[Dimchiko]

Ну в данном случае можно просто навесить

Код Выделить Развернуть

lcase(trim("Замеры "))="замеры"

Спасибо!
Да, трим тоже можно, хотя лайк мне подошел проще)

[Dimchiko]

Скажите, а можно искать не какое-то буквосочетание, а буквосочетание стоящее в ячейке в начале?
Что имею ввиду?
Например:
1) замеры проведенные 7 июля
2) проведенные 7 июля замеры
Мне надо, чтобы скрипт находил только первую фразу, а вторую игнорировал.
а еще в идеале, чтобы искал не "замеры", а "амеры". То есть буквы со 2-ой по 6-ую... Это связано с тем, чтобы не париться с регистром или пробелами.

[Serge 007]

буквосочетание стоящее в ячейке в начале

В моем макросе замените "*амеры*" на "?амеры*"

[Dimchiko]

В моем макросе замените "*амеры*" на "?амеры*"

Доброе утро!
Не подходит, к сожалению.
Потому как если фраза не "замеры 7 июля", а " замеры 7 июля", то он ее не находит...(

[Dimchiko]

Ну в данном случае можно просто навесить

Код Выделить Развернуть

lcase(trim("Замеры "))="замеры"

В моем макросе замените "*амеры*" на "?амеры*"

Или тут как-то это объединить?

[Serge 007]

не "замеры 7 июля", а " замеры 7 июля"

Вы про это не писали в предыдущем вопросе
Тогда так:

Код Выделить Развернуть

If Trim(rR) Like "?амеры*"

[Dimchiko]

Не написал, потому как тестирую на куче смет сразу и проблематика выплывает не сразу...
Спасибо!!!

[Serge 007]

Dimchiko, зачем Вы цитируете посты целиком? Для чего? Какой в этом смысл?
Вот я удалил цитату из последнего Вашего поста. Он что, стал непонятен теперь? Или не доносит до нас Вашу мысль?
Пользуйтесь кнопкой "Ответить", а не кнопкой "Цитата", когда хотите ответить

PS Тему про материалы будете создавать?

[Dimchiko]

Сергей, спасибо за науку!
А с материалами я сам написал код)

Код Выделить Развернуть

    On Error Resume Next
   
    'считаем производство
    Dim LR&, proizvS$, proizvD&, rR1 As Range, rr2 As Range
    Dim proizvR
    LR = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
   
        For Each rR1 In Sheets(1).Range("b17:b" & LR)
            If rR1 Like "*оизводств*" Then
            proizvD = rR1.Row
                For Each rr2 In Sheets(1).Range("b" & proizvD & ":b" & LR)
                    If IsEmpty(rr2) Then
                    proizvR = rr2.Offset(0, 4) + proizvR
                Exit For
                Else
                End If
                Next rr2
            End If
        Next rR1
        Sheets(2).Range("f1") = proizvR
       
        'считаем монтажи
          Dim LRm&, proizvSm$, proizvDm&, rR1m As Range, rr2m As Range
    Dim proizvRm
    LRm = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
 
        For Each rR1m In Sheets(1).Range("b17:b" & LRm)
            If rR1m Like "Монтажи:" Then
            proizvDm = rR1m.Row
                For Each rr2m In Sheets(1).Range("b" & proizvDm & ":b" & LRm)
                    If IsEmpty(rr2m) Then
                    proizvRm = rr2m.Offset(2, 4) + proizvRm
                Exit For
                Else
                End If
                Next rr2m
            End If
        Next rR1m
        Sheets(2).Range("f2") = proizvRm
       
                'считаем замеры
    Dim LRz&, proizvSz$, proizvDz&, rR1z As Range, rr2z As Range
    Dim proizvRz
   
    LRz = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
   
        For Each rR1z In Sheets(1).Range("b17:b" & LRz)
            If rR1z Like "*амер*" Then
            proizvDz = rR1z.Row
                For Each rr2z In Sheets(1).Range("b" & proizvDz & ":b" & LRz)
                    proizvRz = rr2z.Offset(0, 4).Value + proizvRz
                Exit For
                Next rr2z
            End If
        Next rR1z
        Sheets(2).Range("f3") = proizvRz
       
                        'считаем доставки
    Dim LRd&, proizvSd$, proizvDd&, rR1d As Range, rr2d As Range
    Dim proizvRd
   
    LRd = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
   
        For Each rR1d In Sheets(1).Range("b17:b" & LRd)
            If rR1d Like "*оставк*" Then
            proizvDd = rR1d.Row
                For Each rr2d In Sheets(1).Range("b" & proizvDd & ":b" & LRd)
                    proizvRd = rr2d.Offset(0, 4).Value + proizvRd
                Exit For
                Next rr2d
            End If
        Next rR1d
        Sheets(2).Range("f4") = proizvRd
       
                                'считаем такелаж
    Dim LRt&, proizvSt$, proizvDt&, rR1t As Range, rr2t As Range
    Dim proizvRt
   
    LRt = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
   
        For Each rR1t In Sheets(1).Range("b17:b" & LRt)
            If rR1t Like "*акелажн*" Then
            proizvDt = rR1t.Row
                For Each rr2t In Sheets(1).Range("b" & proizvDt & ":b" & LRt)
                    proizvRt = rr2t.Offset(0, 4).Value + proizvRt
                Exit For
                Next rr2t
            End If
        Next rR1t
        Sheets(2).Range("f5") = proizvRt
       
       
            'заполняем материалы
    Dim LRmat&, proizvSmat$, proizvDmat&, rR1mat As Range, rr2mat As Range
    Dim proizvRmat
    'LRmat = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
   
   'Объявляем переменные
'myRange - диапазон ячеек, заполненный исходным списком элементов
'myCell - отдельная ячейка диапазона
'myCollection - коллекция
'myElement - элемент коллекции (должен быть типа "Variant")
Dim myRange As Range, myCell As Range, myCollection As New Collection, _
myElement As Variant, i As Long, s1 As Long, ss1 As Long, sss1 As Long
       
'присваиваем переменной myRange диапазон ячеек с исходным списком элементов
Set myRange = Sheets(1).Range("B17:B2000")
 
'заполняем новую коллекцию уникальными элементами
On Error Resume Next
For Each myCell In myRange
If Trim(myCell) Like "?рамор*" Then
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
ElseIf Trim(myCell) Like "?ранит*" Then
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
ElseIf Trim(myCell) Like "?равертин*" Then
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
ElseIf Trim(myCell) Like "?никс*" Then
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
ElseIf Trim(myCell) Like "?варцит*" Then
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
End If
Next myCell
On Error GoTo 0
'на этом отбор уникальных значений закончен

'добавляем уникальные элементы в ячейки столбца "В" листа 2
Sheets(2).Rows("8:10000").Delete
i = 7
For Each myElement In myCollection
i = i + 1
Sheets(2).Cells(i, 2) = myElement
Sheets(2).Cells(i, 4) = "м2"
Next myElement

'начинаем поиск и переборку
'On Error Resume Next
  With Sheets(2).Range("C8", Cells(Rows.Count, "B").End(xlUp).Offset(, 1))
    .Formula = "=SUMIF(Итог!B:B,B8,Итог!C:C)"
    .Value = .Value
  End With
  Columns("C").Style = "Comma"
 
    With Sheets(2).Range("F8", Cells(Rows.Count, "B").End(xlUp).Offset(, 4))
    .Formula = "=SUMIF(Итог!B:B,B8,Итог!F:F)"
    .Value = .Value
  End With
  Columns("F").Style = "Comma"
 
      With Sheets(2).Range("E8", Cells(Rows.Count, "B").End(xlUp).Offset(, 3))
    .Formula = "=SUMIF(Итог!B:B,B8,Итог!E:E)"
    .Value = .Value
  End With
  Columns("F").Style = "Comma"