Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск значения на листе и перенос всей строки - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Поиск значения на листе и перенос всей строки
giovanni Дата: Вторник, 24.10.2017, 21:35 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Добрый вечер!

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

[vba]
Код
Option Explicit

Sub pois_na_liste()
Dim found_value As Range
Dim iLastRowpoisk As Long, iLastRowresult As Long, i As Long
Dim poisk As Worksheet, gde_poisk As Worksheet, result As Worksheet
Dim firstAddress As String

    Set poisk = Worksheets("poisk")
    Set gde_poisk = Worksheets("gde_poisk")
    Set result = Worksheets("result")
  
    iLastRowpoisk = poisk.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowpoisk = 1 Then
        MsgBox "Нет данных"
        Exit Sub
    End If

    For i = 1 To iLastRowpoisk
        With result
        
            Set found_value = .Columns(1).Find(poisk.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
          
            If Not found_value Is Nothing Then
                
                    iLastRowresult = result.Cells(Rows.Count, 1).End(xlUp).Row + 1
                
                   .Cells(iLastRowresult, 1) = poisk.Cells(i, 1)

            End If
        End With
    Next i
     
End Sub
[/vba]

Данный код не подходит только в одной моменте. Мне необходимо, чтобы значение из листа "poisk" искалось в листе "gde_poisk" и, если значение найдено, то вся строка листа "gde_poisk" копировалась в лист "result". Данный код ищет и переносит только найденную ячейку из искомого листа.
Примерно понимаю, что весь вопрос в этой строке:
[vba]
Код
  .Cells(iLastRowresult, 1) = poisk.Cells(i, 1)
[/vba]
Пытался сделать так:
[vba]
Код
  .Rows(iLastRowresult) = gde_poisk.Rows(i)
[/vba]

Но таким образом перенос не происходит вовсе.
Помогите, пожалуйста, разобраться.


Сообщение отредактировал giovanni - Вторник, 24.10.2017, 21:43
 
Ответить
СообщениеДобрый вечер!

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

[vba]
Код
Option Explicit

Sub pois_na_liste()
Dim found_value As Range
Dim iLastRowpoisk As Long, iLastRowresult As Long, i As Long
Dim poisk As Worksheet, gde_poisk As Worksheet, result As Worksheet
Dim firstAddress As String

    Set poisk = Worksheets("poisk")
    Set gde_poisk = Worksheets("gde_poisk")
    Set result = Worksheets("result")
  
    iLastRowpoisk = poisk.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowpoisk = 1 Then
        MsgBox "Нет данных"
        Exit Sub
    End If

    For i = 1 To iLastRowpoisk
        With result
        
            Set found_value = .Columns(1).Find(poisk.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
          
            If Not found_value Is Nothing Then
                
                    iLastRowresult = result.Cells(Rows.Count, 1).End(xlUp).Row + 1
                
                   .Cells(iLastRowresult, 1) = poisk.Cells(i, 1)

            End If
        End With
    Next i
     
End Sub
[/vba]

Данный код не подходит только в одной моменте. Мне необходимо, чтобы значение из листа "poisk" искалось в листе "gde_poisk" и, если значение найдено, то вся строка листа "gde_poisk" копировалась в лист "result". Данный код ищет и переносит только найденную ячейку из искомого листа.
Примерно понимаю, что весь вопрос в этой строке:
[vba]
Код
  .Cells(iLastRowresult, 1) = poisk.Cells(i, 1)
[/vba]
Пытался сделать так:
[vba]
Код
  .Rows(iLastRowresult) = gde_poisk.Rows(i)
[/vba]

Но таким образом перенос не происходит вовсе.
Помогите, пожалуйста, разобраться.

Автор - giovanni
Дата добавления - 24.10.2017 в 21:35
RAN Дата: Вторник, 24.10.2017, 21:51 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
.Cells(iLastRowresult, 1).EntireRow = poisk.Cells(i, 1).EntireRow
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
.Cells(iLastRowresult, 1).EntireRow = poisk.Cells(i, 1).EntireRow
[/vba]

Автор - RAN
Дата добавления - 24.10.2017 в 21:51
giovanni Дата: Вторник, 24.10.2017, 22:06 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
.Cells(iLastRowresult, 1).EntireRow = poisk.Cells(i, 1).EntireRow


Спасибо за ответ!

Прошу прощения, код, выложенный вначале топика - выложен некорректно.
Вот правильный код:

[vba]
Код
Sub poisk_na_liste()
Dim found_value As Range
Dim iLastRowpoisk As Long, iLastRowresult As Long, i As Long
Dim poisk As Worksheet, gde_poisk As Worksheet, result As Worksheet
Dim firstAddress As String

    Set poisk = Worksheets("poisk")
    Set gde_poisk = Worksheets("gde_poisk")
    Set result = Worksheets("result")
  
    iLastRowpoisk = poisk.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowpoisk = 1 Then
        MsgBox "Нет данных"
        Exit Sub
    End If
    '
    For i = 1 To iLastRowpoisk
        With gde_poisk
     
            Set found_value = .Columns(1).Find(poisk.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
            
            If Not found_value Is Nothing Then
                
                   With result
                    iLastRowresult = .Cells(Rows.Count, 1).End(xlUp).Row + 1
              
              .Cells(iLastRowresult, 1).EntireRow = gde_poisk.Cells(i, 1).EntireRow
                End With

            End If
        End With
    Next i
     
End Sub
[/vba]

Подставил Ваш код, но переноса данных не происходит, лист "result" пустой.

Приложил файл-пример.
Вероятно, я что-то делаю не так.
К сообщению приложен файл: _Microsoft_Exce.xlsm (21.9 Kb)


Сообщение отредактировал giovanni - Вторник, 24.10.2017, 22:08
 
Ответить
Сообщение
.Cells(iLastRowresult, 1).EntireRow = poisk.Cells(i, 1).EntireRow


Спасибо за ответ!

Прошу прощения, код, выложенный вначале топика - выложен некорректно.
Вот правильный код:

[vba]
Код
Sub poisk_na_liste()
Dim found_value As Range
Dim iLastRowpoisk As Long, iLastRowresult As Long, i As Long
Dim poisk As Worksheet, gde_poisk As Worksheet, result As Worksheet
Dim firstAddress As String

    Set poisk = Worksheets("poisk")
    Set gde_poisk = Worksheets("gde_poisk")
    Set result = Worksheets("result")
  
    iLastRowpoisk = poisk.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowpoisk = 1 Then
        MsgBox "Нет данных"
        Exit Sub
    End If
    '
    For i = 1 To iLastRowpoisk
        With gde_poisk
     
            Set found_value = .Columns(1).Find(poisk.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
            
            If Not found_value Is Nothing Then
                
                   With result
                    iLastRowresult = .Cells(Rows.Count, 1).End(xlUp).Row + 1
              
              .Cells(iLastRowresult, 1).EntireRow = gde_poisk.Cells(i, 1).EntireRow
                End With

            End If
        End With
    Next i
     
End Sub
[/vba]

Подставил Ваш код, но переноса данных не происходит, лист "result" пустой.

Приложил файл-пример.
Вероятно, я что-то делаю не так.

Автор - giovanni
Дата добавления - 24.10.2017 в 22:06
RAN Дата: Вторник, 24.10.2017, 22:17 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
.Cells(iLastRowresult, 1).EntireRow.Value = gde_poisk.Cells(i, 1).EntireRow.Value
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
.Cells(iLastRowresult, 1).EntireRow.Value = gde_poisk.Cells(i, 1).EntireRow.Value
[/vba]

Автор - RAN
Дата добавления - 24.10.2017 в 22:17
giovanni Дата: Вторник, 24.10.2017, 22:52 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
.Cells(iLastRowresult, 1).EntireRow.Value = gde_poisk.Cells(i, 1).EntireRow.Value


Огромное спасибо! То, что надо)

Но, оказалось, что этот макрос не совсем то, что нужно. Либо я его так под себя подкорректировал, что сделал какую-то ошибку в коде.
Если я на листе "poisk" вставляю, к примеру адидас и хома, то в лист "result" переносятся строки адидас и пума, то есть, первая и вторая строка с листа, в котором производится поиск - "gde_poisk". (

UPD: после некоторых исправлений, макрос заработал. Спасибо!
К сообщению приложен файл: 0080804.xlsm (21.5 Kb)


Сообщение отредактировал giovanni - Среда, 25.10.2017, 02:04
 
Ответить
Сообщение
.Cells(iLastRowresult, 1).EntireRow.Value = gde_poisk.Cells(i, 1).EntireRow.Value


Огромное спасибо! То, что надо)

Но, оказалось, что этот макрос не совсем то, что нужно. Либо я его так под себя подкорректировал, что сделал какую-то ошибку в коде.
Если я на листе "poisk" вставляю, к примеру адидас и хома, то в лист "result" переносятся строки адидас и пума, то есть, первая и вторая строка с листа, в котором производится поиск - "gde_poisk". (

UPD: после некоторых исправлений, макрос заработал. Спасибо!

Автор - giovanni
Дата добавления - 24.10.2017 в 22:52
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2026 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!