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

Вход

Регистрация

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

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск значения с подстановкой (Макросы/Sub)
Поиск значения с подстановкой
Narahon Дата: Суббота, 24.11.2018, 14:28 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Всем привет!
Возникла задача по поиску значения из одного листа и вставкой другого значения из найденной строки в другом листе в другую ячейку первого листа.
Начал я конечно с формул, так как их я знаю, практикую, но формула мне не подходит, так как если значение не найдено, то в эту ячейку мне нужно вписать всё вручную.

То есть:
1. Я ввожу номер телефона в ячейке B1, макрос ищет это значение на соседнем листе и если находит его в столбце C:C, то берёт значение из ячейки E этой же строки и вставляет в ячейку B2 и на этом завершает цикл.
2. Если макрос не находит это значение, то в ячейке B2 остаётся всё пусто и я в неё вписываю данные вручную

Файлик примера во вложении
К сообщению приложен файл: primer-poiska.xlsx(9.9 Kb)
 
Ответить
СообщениеВсем привет!
Возникла задача по поиску значения из одного листа и вставкой другого значения из найденной строки в другом листе в другую ячейку первого листа.
Начал я конечно с формул, так как их я знаю, практикую, но формула мне не подходит, так как если значение не найдено, то в эту ячейку мне нужно вписать всё вручную.

То есть:
1. Я ввожу номер телефона в ячейке B1, макрос ищет это значение на соседнем листе и если находит его в столбце C:C, то берёт значение из ячейки E этой же строки и вставляет в ячейку B2 и на этом завершает цикл.
2. Если макрос не находит это значение, то в ячейке B2 остаётся всё пусто и я в неё вписываю данные вручную

Файлик примера во вложении

Автор - Narahon
Дата добавления - 24.11.2018 в 14:28
nilem Дата: Суббота, 24.11.2018, 15:03 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1482
Репутация: 520 ±
Замечаний: 0% ±

Excel 2013
Narahon, привет
попробуйте
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address(0, 0) <> "B1" Then Exit Sub

Dim r As Range
Set r = Sheets("Данные").Columns(3).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
    Range("B2").Value = "fone nicht"
Else
    Range("B2").Value = r(1, 3).Value
End If
End Sub
[/vba]
К сообщению приложен файл: primer-poiska.xlsm(16.3 Kb)


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеNarahon, привет
попробуйте
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address(0, 0) <> "B1" Then Exit Sub

Dim r As Range
Set r = Sheets("Данные").Columns(3).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
    Range("B2").Value = "fone nicht"
Else
    Range("B2").Value = r(1, 3).Value
End If
End Sub
[/vba]

Автор - nilem
Дата добавления - 24.11.2018 в 15:03
Narahon Дата: Суббота, 24.11.2018, 16:22 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
попробуйте

Огромное спасибо, сейчас буду испытывать
 
Ответить
Сообщение
попробуйте

Огромное спасибо, сейчас буду испытывать

Автор - Narahon
Дата добавления - 24.11.2018 в 16:22
Narahon Дата: Суббота, 24.11.2018, 17:49 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Narahon, привет
попробуйте


В отдельном файле всё работает отлично, но у меня есть сделанная таблица и в ней, к сожалению, не работает этот макрос, чувствую, что мешает другой код:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    ad_ = Target.Address(0, 0)
    With Sheets("Данные")
        r0_ = 3
        c0_ = 1
        r1_ = .Cells(.Rows.Count, c0_).End(3).Row
        c1_ = 16
        nr_ = r1_ - r0_ + 1
        nc_ = c1_ - c0_ + 1
        ar = .Cells(r0_, c0_).Resize(nr_, nc_)
    End With
    Select Case ad_
        Case "B4"
            c_ = 4
'        Case "B6"
'            c_ = 6
        Case "B7"
            c_ = 7
            cñ_ = 6
        Case "E7"
            c_ = 15
        Case Else
            Exit Sub
    End Select
    ReDim ar1(1 To 8, 1 To 1)
    ReDim ar2(1 To 8, 1 To 1)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        If cñ_ Then
            z_ = Target.Offset(-1).Value & Target.Value
            For i = 1 To nr_
                .Item(ar(i, cñ_) & ar(i, c_)) = i
            Next i
        Else
            z_ = Target.Value
            For i = 1 To nr_
                .Item(ar(i, c_)) = i
            Next i
        End If
        If .Exists(z_) Then
            str_ = .Item(z_)
            For j = 1 To 8
                ar1(j, 1) = ar(str_, j)
                ar2(j, 1) = ar(str_, j + 8)
            Next j
            Application.EnableEvents = 0
            Range("B1").Resize(8) = ar1
            Range("E1").Resize(7) = ar2
            Application.EnableEvents = 1
        End If
    End With
    
End Sub
[/vba]

Значение для поиска находится всегда в ячейке B4, а значение для подстановки в 18 столбце, я ячейка для заполнения E20? я немного переделывал Ваш код под себя, но код не работает((

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address(0, 0) <> "B4" Then Exit Sub

Dim r As Range
Set r = Sheets("Данные").Columns(4).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
    Range("E20").Value = "fone nicht"
Else
    Range("E20").Value = r(1, 17).Value
End If
End Sub
[/vba]
 
Ответить
Сообщение
Narahon, привет
попробуйте


В отдельном файле всё работает отлично, но у меня есть сделанная таблица и в ней, к сожалению, не работает этот макрос, чувствую, что мешает другой код:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    ad_ = Target.Address(0, 0)
    With Sheets("Данные")
        r0_ = 3
        c0_ = 1
        r1_ = .Cells(.Rows.Count, c0_).End(3).Row
        c1_ = 16
        nr_ = r1_ - r0_ + 1
        nc_ = c1_ - c0_ + 1
        ar = .Cells(r0_, c0_).Resize(nr_, nc_)
    End With
    Select Case ad_
        Case "B4"
            c_ = 4
'        Case "B6"
'            c_ = 6
        Case "B7"
            c_ = 7
            cñ_ = 6
        Case "E7"
            c_ = 15
        Case Else
            Exit Sub
    End Select
    ReDim ar1(1 To 8, 1 To 1)
    ReDim ar2(1 To 8, 1 To 1)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        If cñ_ Then
            z_ = Target.Offset(-1).Value & Target.Value
            For i = 1 To nr_
                .Item(ar(i, cñ_) & ar(i, c_)) = i
            Next i
        Else
            z_ = Target.Value
            For i = 1 To nr_
                .Item(ar(i, c_)) = i
            Next i
        End If
        If .Exists(z_) Then
            str_ = .Item(z_)
            For j = 1 To 8
                ar1(j, 1) = ar(str_, j)
                ar2(j, 1) = ar(str_, j + 8)
            Next j
            Application.EnableEvents = 0
            Range("B1").Resize(8) = ar1
            Range("E1").Resize(7) = ar2
            Application.EnableEvents = 1
        End If
    End With
    
End Sub
[/vba]

Значение для поиска находится всегда в ячейке B4, а значение для подстановки в 18 столбце, я ячейка для заполнения E20? я немного переделывал Ваш код под себя, но код не работает((

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address(0, 0) <> "B4" Then Exit Sub

Dim r As Range
Set r = Sheets("Данные").Columns(4).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
    Range("E20").Value = "fone nicht"
Else
    Range("E20").Value = r(1, 17).Value
End If
End Sub
[/vba]

Автор - Narahon
Дата добавления - 24.11.2018 в 17:49
nilem Дата: Суббота, 24.11.2018, 18:03 | Сообщение № 5
Группа: Авторы
Ранг: Старожил
Сообщений: 1482
Репутация: 520 ±
Замечаний: 0% ±

Excel 2013
Видимо, нужен ваш файл целиком: с примерами данных и всеми макросами


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеВидимо, нужен ваш файл целиком: с примерами данных и всеми макросами

Автор - nilem
Дата добавления - 24.11.2018 в 18:03
InExSu Дата: Воскресенье, 25.11.2018, 16:54 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 431
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
Привет!

Нечто похожее делал где-то тут
Код придётся заточить.


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!

Нечто похожее делал где-то тут
Код придётся заточить.

Автор - InExSu
Дата добавления - 25.11.2018 в 16:54
Narahon Дата: Пятница, 30.11.2018, 10:36 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Видимо, нужен ваш файл целиком: с примерами данных и всеми макросами


Добрый день! Только добрался до компьютера. Файлик примера со всеми макросами во вложении
К сообщению приложен файл: primer-poiska-2.xlsm(57.6 Kb)
 
Ответить
Сообщение
Видимо, нужен ваш файл целиком: с примерами данных и всеми макросами


Добрый день! Только добрался до компьютера. Файлик примера со всеми макросами во вложении

Автор - Narahon
Дата добавления - 30.11.2018 в 10:36
Narahon Дата: Среда, 05.12.2018, 12:15 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Что-то я сам пытался сделать, но так ничего и не вышло, совсем плохо с макросами дружу((
 
Ответить
СообщениеЧто-то я сам пытался сделать, но так ничего и не вышло, совсем плохо с макросами дружу((

Автор - Narahon
Дата добавления - 05.12.2018 в 12:15
boa Дата: Среда, 05.12.2018, 21:58 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 277
Репутация: 57 ±
Замечаний: 0% ±

2013, 365
Narahon,
на основании макроса nilem подправил ваш Worksheet_Change

обратите внимание, что надо или
[vba]
Код
...Find(Target.Value, LookIn:=xlFormulas,...
[/vba]
или [vba]
Код
...Find(Target.Text, LookIn:=xlValues,...
[/vba]
т.к. значение ячейки(Value) у вас изменено форматированием.




Сообщение отредактировал boa - Среда, 05.12.2018, 22:04
 
Ответить
СообщениеNarahon,
на основании макроса nilem подправил ваш Worksheet_Change

обратите внимание, что надо или
[vba]
Код
...Find(Target.Value, LookIn:=xlFormulas,...
[/vba]
или [vba]
Код
...Find(Target.Text, LookIn:=xlValues,...
[/vba]
т.к. значение ячейки(Value) у вас изменено форматированием.

Автор - boa
Дата добавления - 05.12.2018 в 21:58
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск значения с подстановкой (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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