Страницы: 1
RSS
Поиск данных на листе
 
Добрый вечер, уважаемые участники форума.
Помогите, пожалуйста, разобраться в вопросе.
Есть задача произвести поиск в большой таблице на одном листе. Искомые значения располагаются на отдельном листе. Если значение найдено, то вся строка, в которой найдено искомое значение, переносится на отдельный лист.
Следующий макрос решает описанную выше задачу:

Код
Sub test()

 Set find_text = Worksheets("find_text")
    Set find_text_sheet = Worksheets("find_text_sheet")
    Set result = Worksheets("result")
    Dim x As Range
   
    LRow = find_text.Cells(Rows.Count, 1).End(xlUp).Row
    
    If LRow = 1 Then
        MsgBox "Нет данных на листе"
        Exit Sub
    End If
     
    For i = 1 To LRow
    
    Set x = find_text_sheet.Range("a:p").Find(find_text.Cells(i, 1), , xlValues, xlWhole)
    If Not x Is Nothing Then
        LRow_result = result.Cells(Rows.Count, 1).End(xlUp).Row + 1
        result.Rows(LRow_result).EntireRow.Value = find_text_sheet.Rows(x.Row).EntireRow.Value
    End If
 
    Next i

End Sub

В данном макросе искомое значение находится в ячейке "Cells(i.1), то есть, в ячейках столбца "А", т.е., сначала ищется содержимое ячейки"А1", потом "А2" и т.д. согласно циклу.
Подскажите, пожалуйста, можно ли доработать данный макрос так, чтобы поиск происходил по ячейкам "А1, В1, С1", в том случае, если в ячейках "В1" и "С1" есть содержимое, а если в них содержимого нет, то поиск происходил бы как сейчас только по ячейке "А1" и т..д. и поиск считался бы успешным, если содержимое ячеек "А1", "В1" и "С1" найдены в одной строке вместе?

Спасибо.
Изменено: footballplayer - 28.03.2018 21:04:49
 
Файл-пример. Как есть-Как надо
Согласие есть продукт при полном непротивлении сторон
 
Sanja, спасибо за ответ.
Файл  с примером приложил.

В настоящий момент макрос ищет данные, введенные в столбце "А" листа "find_text" по очереди во всех ячейках диапазона "A:P" листа "text".
Если значение находится, то происходит перенос той строки, в которой найдено значение на лист "result".
Мне необходимо, чтобы искалось значение не одной ячейки столбца "А", а поиск происходил по трем ячейкам столбцов  "А", "В" и "С" (если они заполнены)  и поиск считался успешным только тогда, когда в одной строке найдено совпадение по трем ячейкам, если заполнены только две ячейки искомой строки, то поиск считался бы успешным при совпадении двух искомых значение в одной строке и если заполнена только одна ячейка искомой строки, то поиск шел только по одной.
Вероятнее всего я объясняю совсем непонятно. В файле примере на первом листе указал три строки с искомыми ячейками -  в одной строке три ячейка заполнены, в другой одна ячейка и в третьей заполнено две ячейки. На третьем листе "result" указал результат, то есть, если искомые значение были найдены в строке, то вся строка перенеслась со второго листа на третий.
 
А вы уверены что поиск работает корректно, я дублировал строки и дубли макрос не перенес на новый лист.
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, спасибо за ответ.

Забыл написать, что повторов на листе, в котором происходит поиск  - не бывает.
В идеале собираюсь подкорректировать макрос так, чтобы он не просто копировал строки, где найдено искомое значение, но и удалял их после копирования. Поэтому даже если некоторое количество повторов будет, можно будет просто несколько раз запустить макрос и эти повторные значения доперенести.
Изменено: footballplayer - 28.03.2018 21:32:43
 
Честно говоря слабо понятно, что именно требуется, на всякий случай посмотрите м.б. подойдет.
Код
Sub test()
    Dim dic As Object, lrow&
    Dim arr(), i&, itxt$, ikey, iarr(), larr$()
    
    Set dic = CreateObject("Scripting.Dictionary")
    With sheet2: arr = .Range(.[c1], .[a1].End(xlDown)).Value: End With
    With sheet1: iarr = .Range(.[c1], .[a1].End(xlDown)).Value: End With
    For i = 1 To UBound(arr)
        itxt = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
        dic.Item(CStr(itxt)) = dic.Item(CStr(itxt)) & "|" & i
    Next i
    For i = 1 To UBound(iarr)
        itxt = iarr(i, 1) & "|" & iarr(i, 2) & "|" & iarr(i, 3)
        If dic.Exists(itxt) Then
            larr = Split(Mid(dic.Item(itxt), 2), "|")
            For Each ikey In larr
                lrow = sheet3.Range("a" & sheet3.Rows.Count).End(xlUp).Row
                sheet2.Rows(ikey).Copy sheet3.Rows(lrow + 1)
            Next ikey
        End If
    Next i
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
С удалением сложнее, тут нужно идти от последней строки к первой иначе на удаляете. как вариант можно занести все в массив и там обработать а затем выгрузить данные на листы. вот так как-то.
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, спасибо за ответ.

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

Если попробовать объяснить на примере кода, то мне необходимо (если это возможно), доработать этот кусок кода:
Код
Set x = Text.Range("a:s").Find(find_text.Cells(i, 1), , xlValues, xlWhole)



чтобы поиск происходил не по одной ячейке Cells(i, 1), а по нескольким ячейкам строки, к примеру
Код
Set x = Text.Range("a:s").Find(find_text.Cells(i, 1) & Cells(i, 2) & Cells(i, 3), , xlValues, xlWhole)

и поиск считался успешным, если значение трех ячеек найдено в одной строке.
В остальном, исходный макрос полностью устраивает и решает задачу.
Изменено: footballplayer - 28.03.2018 21:42:19
 
Я не знаю можно ли методом Find решить вашу задачу. Что за ошибку выдал макрос?
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх