|
Если Вам необходимо, сразу после ввода текста, автоматически исправлять
наиболее часто встречающиеся ошибки, например, поменять exel на excel,
или же, облегчить себе ввод некого текста, например, сделать так, чтобы
после ввода с1 (сотрудник1) в ячейке появилось ФИО соответствующего
сотрудника, то для этого можно воспользоваться стандартной
АвтоЗаменой,
однако, такая замена будет применяться ко всем ячейкам, если же
нужно ограничиться только опредёленной рабочей книгой, более того,
листы и диапазоны, в которых нужно применять автозамену, могут
меняться и Вам необходимо иметь возможность их корректировать, то
можно создать свой собственный список замены и диапазонов (см. скриншот)
Для этого, откройте нужную рабочую книгу,
добавьте новый рабочий лист, присвойте ему имя "Замена" и определите
диапазон в котором будет перечислены листы и диапазоны, в примере, это
[B3:C12] (столбец B предназначен для имён листов, а столбец C для адресов)
и диапазон, содержащий список автозамены, в примере, он начинается с
ячейки [B15]
(столбец B содержит перечень текста, подлежащего замене, а столбец C
должен содержать текст, на который нужно заменить текст из столбца B)
Теперь, заполните собственный список автозамены.

Затем, добавьте в модуль книги ThisWorkbook(ЭтаКнига) следующее событие :
|
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim iSource As Range, iDiapazon As Range, iRow&, iText$, iAddress 'As Variant
With ThisWorkbook.Worksheets("Замена") 'Me.Worksheets("Замена")
iAddress = Application.VLookup(Sh.Name, .[B3:C12], 2, 0)
If Not IsError(iAddress) Then
Set iSource = Intersect(Target, Sh.Range(iAddress))
If Not iSource Is Nothing Then
Set iDiapazon = .Range(.[B15], .[B65536].End(xlUp))
Application.EnableEvents = False
'Application.ScreenUpdating = False
For iRow = 1 To iDiapazon.Count 'iDiapazon.Rows.Count
iText = iDiapazon(iRow, 1)
If Not iSource.Find(iText, , xlFormulas) Is Nothing Then
iSource.Replace iText, iDiapazon(iRow, 2), xlPart
End If
Next
'Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End If
End With
End Sub |
А в модуль рабочего листа Замена скопируйте событие
Worksheet_BeforeDoubleClick , затем сохраните изменения,
и когда Вам понадобится внести имя листа и адрес диапазона, просто
кликните дважды любую ячейку диапазона [B3:C12] и с помощью
диалогового окна выделите нужный диапазон и кликните кнопку Ok.
|
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Not Intersect(Target, [B3:C12]) Is Nothing Then
On Error Resume Next
Dim iSource As Range
Set iSource = Application.InputBox("Выберите диапазон", "", Type:=8)
If Not iSource Is Nothing Then
If Not iSource.Parent Is ActiveSheet Then
'[B:C].Rows(Target.Row).Value = Array( _
iSource.Parent.Name, iSource.Address(False, False))
With Intersect(Target.EntireRow, [B:C])
.NumberFormat = "@"
.Value = Array(iSource.Parent.Name, iSource.Address(False, False))
End With
End If
End If
Cancel = True
End If
End Sub |
Автор : Климов Павел Юрьевич
|
|
© 2004-2016 Климов П.Ю. Все права защищены. |
WebDesign & Error's
Klimoff
|