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

Вход

Регистрация

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

 

= Мир MS Excel/исправить .find метод - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » исправить .find метод (Макросы/Sub)
исправить .find метод
rosko Дата: Среда, 08.02.2017, 01:59 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток, Форумчане!

Прошу Вашей помощи, столкнулся с тем, что range.find выдает не то, что хотелось бы.
Нужно было подтянуть по названию фирмы (4 строка 1 листа и 1 столбец второго листа) три значения на первый лист (со второго).
И по первой же фирме подтянулись не те значения(

[vba]
Код
Sub new_()

ThisWorkbook.Sheets(1).Activate

last_col_main = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column

Set mainrang = ActiveSheet.Range(Cells(4, 1), Cells(4, last_col_main))

For i = 2 To ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next

needed = mainrang.Find(ThisWorkbook.Sheets(2).Cells(i, 1), , , xlWhole).Column

ThisWorkbook.Sheets(1).Cells(1, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 9)
ThisWorkbook.Sheets(1).Cells(2, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 10)
ThisWorkbook.Sheets(1).Cells(3, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 11)

Next

End Sub
[/vba]
К сообщению приложен файл: portfolio_sampl.xlsx (89.0 Kb)
 
Ответить
СообщениеДоброго времени суток, Форумчане!

Прошу Вашей помощи, столкнулся с тем, что range.find выдает не то, что хотелось бы.
Нужно было подтянуть по названию фирмы (4 строка 1 листа и 1 столбец второго листа) три значения на первый лист (со второго).
И по первой же фирме подтянулись не те значения(

[vba]
Код
Sub new_()

ThisWorkbook.Sheets(1).Activate

last_col_main = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column

Set mainrang = ActiveSheet.Range(Cells(4, 1), Cells(4, last_col_main))

For i = 2 To ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next

needed = mainrang.Find(ThisWorkbook.Sheets(2).Cells(i, 1), , , xlWhole).Column

ThisWorkbook.Sheets(1).Cells(1, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 9)
ThisWorkbook.Sheets(1).Cells(2, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 10)
ThisWorkbook.Sheets(1).Cells(3, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 11)

Next

End Sub
[/vba]

Автор - rosko
Дата добавления - 08.02.2017 в 01:59
doober Дата: Среда, 08.02.2017, 04:13 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
И по первой же фирме подтянулись не те значения(

А так?[vba]
Код

Sub new_()
    ThisWorkbook.Sheets(1).Activate
    last_col_main = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column
    Set mainrang = ActiveSheet.Range(Cells(4, 1), Cells(4, last_col_main))
    For i = 2 To ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
        Set x = mainrang.Find(ThisWorkbook.Sheets(2).Cells(i, 1), , , xlWhole)
        If Not x Is Nothing Then
            needed = x.Column
            ThisWorkbook.Sheets(1).Cells(1, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 9)
            ThisWorkbook.Sheets(1).Cells(2, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 10)
            ThisWorkbook.Sheets(1).Cells(3, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 11)
        End If
    Next
End Sub
[/vba]


 
Ответить
Сообщение
И по первой же фирме подтянулись не те значения(

А так?[vba]
Код

Sub new_()
    ThisWorkbook.Sheets(1).Activate
    last_col_main = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column
    Set mainrang = ActiveSheet.Range(Cells(4, 1), Cells(4, last_col_main))
    For i = 2 To ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
        Set x = mainrang.Find(ThisWorkbook.Sheets(2).Cells(i, 1), , , xlWhole)
        If Not x Is Nothing Then
            needed = x.Column
            ThisWorkbook.Sheets(1).Cells(1, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 9)
            ThisWorkbook.Sheets(1).Cells(2, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 10)
            ThisWorkbook.Sheets(1).Cells(3, needed).Value = ThisWorkbook.Sheets(2).Cells(i, 11)
        End If
    Next
End Sub
[/vba]

Автор - doober
Дата добавления - 08.02.2017 в 04:13
rosko Дата: Среда, 08.02.2017, 09:51 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
doober,
отлично работает!
Благодарю!
 
Ответить
Сообщениеdoober,
отлично работает!
Благодарю!

Автор - rosko
Дата добавления - 08.02.2017 в 09:51
rosko Дата: Пятница, 10.02.2017, 07:56 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
нашел проблему, связанную с качеством данных. На листе "2" фирмы из разных секторов
иногда имеют одно название, поэтому .find сбоит(
К сообщению приложен файл: frame.xlsx (98.6 Kb)
 
Ответить
Сообщениенашел проблему, связанную с качеством данных. На листе "2" фирмы из разных секторов
иногда имеют одно название, поэтому .find сбоит(

Автор - rosko
Дата добавления - 10.02.2017 в 07:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » исправить .find метод (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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