У меня есть один рабочий лист для настройки источников данных нескольких списков проверки данных. другими словами, я использую этот лист для предоставления раскрывающихся списков нескольким другим листам.
Мне нужно динамически обновлять все листы при любом одном или нескольких изменениях в листе источника данных. Я могу понять, что это должно прийти с макросом события по всей книге.
Мой вопрос заключается в том, как добиться этого, сохраняя формулу "СМЕЩЕНИЕ" по всей книге?
Спасибо
Чтобы поддержать мой вопрос, я поместил фрагмент кода, который пытаюсь заставить его работать:
Предоставлена следующая информация:
- Я использую такую формулу для псевдодинамического обновления выпадающих списков, например:
= OFFSET(MyDataSourceSheet!$ O $ 2; 0; 0; COUNTA(MyDataSourceSheet!О: О)-1)
- Я заглянул в главу о событиях в книге о Пирсоне, но я слишком новичок для этого.
- Я понимаю этот макрос и успешно его реализовал в виде теста с выпадающим списком на том же листе, что и источник данных. Я хочу сказать, что я не знаю, как развернуть это по всей книге.
Макрос, связанный с таблицей источника данных:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Macro to update all worksheets with drop down list referenced upon
' this data source worksheet, base on ref names
Dim cell As Range
Dim isect As Range
Dim vOldValue As Variant, vNewValue As Variant
Dim dvLists(1 To 6) As String 'data validation area
Dim OneValidationListName As Variant
dvLists(1) = "mylist1"
dvLists(2) = "mylist2"
dvLists(3) = "mylist3"
dvLists(4) = "mylist4"
dvLists(5) = "mylist5"
dvLists(6) = "mylist6"
On Error GoTo errorHandler
For Each OneValidationListName In dvLists
'Set isect = Application.Intersect(Target, ThisWorkbook.Names("STEP").RefersToRange)
Set isect = Application.Intersect(Target, ThisWorkbook.Names(OneValidationListName).RefersToRange)
' If a change occured in the source data sheet
If Not isect Is Nothing Then
' Prevent infinite loops
Application.EnableEvents = False
' Get previous value of this cell
With Target
vNewValue = .Value
Application.Undo
vOldValue = .Value
.Value = vNewValue
End With
' LOCAL dropdown lists : For every cell with validation
For Each cell In Me.UsedRange.SpecialCells(xlCellTypeAllValidation)
With cell
' If it has list validation AND the validation formula matches AND the value is the old value
If .Validation.Type = 3 And .Validation.Formula1 = "=" & OneValidationListName And .Value = vOldValue Then
' Debug
' MsgBox "Address: " & Target.Address
' Change the cell value
cell.Value = vNewValue
End If
End With
Next cell
' Call to other worksheets update macros
Call Sheets(5).UpdateDropDownList(vOldValue, vNewValue)
' GoTo NowGetOut
Application.EnableEvents = True
End If
Next OneValidationListName
NowGetOut:
Application.EnableEvents = True
Exit Sub
errorHandler:
MsgBox "Err " & Err.Number & " : " & Err.Description
Resume NowGetOut
End Sub
Макрос UpdateDropDownList, связанный с рабочим листом назначения:
Sub UpdateDropDownList(Optional vOldValue As Variant, Optional vNewValue As Variant)
' Debug
MsgBox "Received info for update : " & vNewValue
' For every cell with validation
For Each cell In Me.UsedRange.SpecialCells(xlCellTypeAllValidation)
With cell
' If it has list validation AND the validation formula matches AND the value is the old value
' If .Validation.Type = 3 And .Value = vOldValue Then
If .Validation.Type = 3 And .Value = vOldValue Then
' Change the cell value
cell.Value = vNewValue
End If
End With
Next cell
End Sub