Доброго времени суток! Есть список некоторых высказываний по 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.Паштет
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]
Паштет, привет попробуйте так: [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
Решил немного апргрейдить программу, чтобы данная операция производилась не только в указанной ячейке, а во всех строках столбца 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