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

Вход

Регистрация

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

 

= Мир MS Excel/Автоматическая подставновка текста в ячейку по фрагменту - Мир MS Excel

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

Excel 2010
Доброго времени суток!
Есть список некоторых высказываний по 8 слов в каждом, которые построчно записаны в столбец L. Нужно в ячейку H5 вписать одно из высказываний, путем ввода только одного любого слова из него. Слова во фразах не повторяются.
На первый взгляд просто. но заткнулся на процессе поиска:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String
If Not Intersect(Target, Range("H5")) Is Nothing Then
   If Target <> 0 Then
     a = Range("H5").Text
       Range("H5") = Columns("L").Find(What = a, , LookIn:=xlValues, LookAt:=xlPart)
   End If
End If
End Sub

[/vba]При попытке вписать что-то в ячейку, ругается на строку с Find.
 
Ответить
СообщениеДоброго времени суток!
Есть список некоторых высказываний по 8 слов в каждом, которые построчно записаны в столбец L. Нужно в ячейку H5 вписать одно из высказываний, путем ввода только одного любого слова из него. Слова во фразах не повторяются.
На первый взгляд просто. но заткнулся на процессе поиска:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String
If Not Intersect(Target, Range("H5")) Is Nothing Then
   If Target <> 0 Then
     a = Range("H5").Text
       Range("H5") = Columns("L").Find(What = a, , LookIn:=xlValues, LookAt:=xlPart)
   End If
End If
End Sub

[/vba]При попытке вписать что-то в ячейку, ругается на строку с Find.

Автор - Паштет
Дата добавления - 12.11.2020 в 20:16
nilem Дата: Четверг, 12.11.2020, 20:41 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1587
Репутация: 548 ±
Замечаний: 0% ±

Excel 2013, 2016
Паштет, привет
попробуйте так:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String, r As Range
If Target.Address(0, 0) = "H5" Then
    If Len(Target.Value) > 0 Then
        a = Target.Value
        Set r = Columns("L:L").Find(What:=a, LookIn:=xlValues, LookAt:=xlPart)
        If Not r Is Nothing Then
            With Application
                .EnableEvents = False
                Range("H5").Value = r.Value
                .EnableEvents = True
            End With
        End If
    End If
End If
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеПаштет, привет
попробуйте так:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String, r As Range
If Target.Address(0, 0) = "H5" Then
    If Len(Target.Value) > 0 Then
        a = Target.Value
        Set r = Columns("L:L").Find(What:=a, LookIn:=xlValues, LookAt:=xlPart)
        If Not r Is Nothing Then
            With Application
                .EnableEvents = False
                Range("H5").Value = r.Value
                .EnableEvents = True
            End With
        End If
    End If
End If
End Sub
[/vba]

Автор - nilem
Дата добавления - 12.11.2020 в 20:41
Паштет Дата: Четверг, 12.11.2020, 20:45 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 123
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Супер! Работает. Спасибо!
 
Ответить
СообщениеСупер! Работает. Спасибо!

Автор - Паштет
Дата добавления - 12.11.2020 в 20:45
Паштет Дата: Вторник, 17.11.2020, 15:48 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 123
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Решил немного апргрейдить программу, чтобы данная операция производилась не только в указанной ячейке, а во всех строках столбца L начиная с 5 строки. Но никак не получается взять адрес с активной ячейки, адрес берется с новой ячейки после нажатия на Enter или tab, но проблема в том, что эти кнопки дают два разных перехода по направлениям. Если для Enter'а я придумал обход, то одновременно и для tab в голову не приходит. Но больше всего меня беспокоит, что нельзя получить сразу адрес ячейки. Как быть?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String, r As Range
y = ActiveCell.Column
If y = 8 Then GoTo 7 Else End
7: s = ActiveCell.Row - 1
If s > 4 Then GoTo 10 Else End
10: x = "H" & s
If Target.Address(0, 0) = x Then
    If Len(Target.Value) > 0 Then
        a = Target.Value
        Set r = Columns("L:L").Find(What:=a, LookIn:=xlValues, LookAt:=xlPart)
        If Not r Is Nothing Then
            With Application
                .EnableEvents = False
                 Range(x).Value = r.Value
                .EnableEvents = True
            End With
        End If
    End If
End If
End Sub
[/vba]
 
Ответить
СообщениеРешил немного апргрейдить программу, чтобы данная операция производилась не только в указанной ячейке, а во всех строках столбца L начиная с 5 строки. Но никак не получается взять адрес с активной ячейки, адрес берется с новой ячейки после нажатия на Enter или tab, но проблема в том, что эти кнопки дают два разных перехода по направлениям. Если для Enter'а я придумал обход, то одновременно и для tab в голову не приходит. Но больше всего меня беспокоит, что нельзя получить сразу адрес ячейки. Как быть?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String, r As Range
y = ActiveCell.Column
If y = 8 Then GoTo 7 Else End
7: s = ActiveCell.Row - 1
If s > 4 Then GoTo 10 Else End
10: x = "H" & s
If Target.Address(0, 0) = x Then
    If Len(Target.Value) > 0 Then
        a = Target.Value
        Set r = Columns("L:L").Find(What:=a, LookIn:=xlValues, LookAt:=xlPart)
        If Not r Is Nothing Then
            With Application
                .EnableEvents = False
                 Range(x).Value = r.Value
                .EnableEvents = True
            End With
        End If
    End If
End If
End Sub
[/vba]

Автор - Паштет
Дата добавления - 17.11.2020 в 15:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматическая подставновка текста в ячейку по фрагменту (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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