Макрос автоматической замены текста после ввода

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Макрос автоматической замены текста после ввода (Макросы/Sub)

h1dex

Дата: Пятница, 06.05.2022, 07:51 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 42

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

добрый день..к сожалению не могу найти макрос по автоматическому изменению текста при вводе т.е. мне нужно чтобы при вводе к примеру ''яблоко'' и нажатию Enter или переходу на другую ячейку макрос автоматом менял на ''apple''

я нашёл только такой макрос при нажатии на кнопку, а как сделать автоматическое изменение после ввода?

мне здесь уже скидывали похожее:

[vba]

Код

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Sheets(2)
Set Cel = .Range("A:A").Find(What:=Target, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End With
If Cel Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, 1) = Cel.Offset(0, 1)
Target.Offset(0, 2) = Cel.Offset(0, 2)
Target.Offset(0, 3) = Cel.Offset(0, 3)
Target.Offset(0, 4) = Cel.Offset(0, 4)
Application.EnableEvents = True
End Sub

[/vba]

но это макрос, который берёт данные с соседнего листа..а как сделать без листа..чтобы условия и столбец поиска прописывались в самом макросе?..может есть у кого то готовое решение?

Сообщение отредактировал h1dex - Пятница, 06.05.2022, 08:15

Ответить

jun

Дата: Пятница, 06.05.2022, 10:19 | Сообщение № 2

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 145

Репутация: 43 ±

Замечаний: 0% ±

h1dex, Приветствую!
Можно, например так:
[vba]

Код

Sub FindAndReplace()
Dim arr, i, j
arr = Cells(1, 1).CurrentRegion
For Each j In arr
    i = FindInArray("яблоко", arr)
    If Not IsEmpty(i) Then arr(i(0), i(1)) = "apple"
Next j
Cells(1, 5).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub
Private Function FindInArray(what, arr)
Dim i, j
For i = LBound(arr, 1) To UBound(arr, 1)
    For j = LBound(arr, 2) To UBound(arr, 2)
        If arr(i, j) = what Then FindInArray = Array(i, j): Exit Function
    Next j
Next i
End Function

[/vba]
либо в модуль листа код:
[vba]

Код

Private Sub Worksheet_Change(ByVal target As Range)
If target.Count <> 1 Then Exit Sub
If target.Value = "яблоко" Then target.Value = "apple"
End Sub

[/vba]
будет заменять яблоко на apple при каждом вводе, если введено слово яблоко