如果 Worksheet_Change 的目標被洗掉，我想洗掉單元格的驗證或設定一個空的驗證。
目標單元格是一個合并的單元格，它也有一個xlValidateList. 如果我選擇其中一個值，我的代碼運行正常，但是當我洗掉此單元格的內容時，它不會更改另一個單元格的驗證。
我認為它來自細胞的合并或因為它有一個 xlValidateList
我試圖檢查IsEmpty(Target)但它總是錯誤的，即使我洗掉了目標單元格的內容
到目前為止我的代碼：
Private Sub Worksheet_Change(ByVal Target As range)
Dim lengthFromCell As range
Dim lengthToCell As range
' only execute when on column F and
If Target.Column <> 6 Or Target.Cells.Count > 1 Then Exit Sub
Set lengthFromCell = Target.Offset(0, 1)
Set lengthToCell = lengthFromCell.Offset(1, 0)
' Delete contents of "length" cells
lengthFromCell.value = ""
lengthToCell.value = ""
If Target.value = "A" Then
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="1, 2, 3"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = ""
.ErrorMessage = ""
.ShowError = True
End With
ElseIf Target.value = "B" Then
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="4, 5, 6"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = ""
.ErrorMessage = ""
.ShowError = True
End With
Else
'here either delete the validation or at least set it to 0 or ""
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="0, 0, 0"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = ""
.ErrorMessage = ""
.ShowError = True
End With
End If
End Sub
編輯：
“目標”是Worksheet_Change型別為 的目標Range。所以它是合并的單元格，其中包含值為“A 和 B”的下拉串列。
The main problem is that my code doesn't recognice the deletion of the value "A" in merged cells, but in single cells it does.
uj5u.com熱心網友回復：
請嘗試下一個功能：
Function isMergeEmpty(rng As Range) As Boolean
Dim x As String
On Error Resume Next
x = rng.value
If err.Number <> 0 Then
isMergeEmpty = True
End If
On Error GoTo 0
End Function
可以通過這種方式從事件中呼叫它：
Private Sub Worksheet_Change(ByVal Target As Range)
If isMergeEmpty(Target) Then
'do here what you need...
MsgBox "Empty merge cell..."
End if
End Sub
編輯：
請測驗下一個完整的解決方案：
Private Sub Worksheet_Change(ByVal Target As range)
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
myList.Add "Einseitig", 1
myList.Add "Doppelseitig", 2
myList.Add "Halbzylinder", 3
Dim lengthFromCell As range
Dim lengthToCell As range
' only execute when on column F and no more of one cell (IF Target is NOT merged):
If Target.Column <> 6 Or (Target.Cells.Count > 1 And Target.MergeCells = False) Then Exit Sub
Set lengthFromCell = Target.Offset(0, 1)
Set lengthToCell = lengthFromCell.Offset(1, 0)
Application.EnableEvents = False 'to avoid the event running three times
'it will also be triggered for each of the following lines:
' Delete contents of "length" cells
lengthFromCell.value = ""
lengthToCell.value = ""
If isMergeEmpty(Target) Then 'it should be first, in order to avoid `Target.value` which returns an error for an empty merged range
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="0, 0, 0"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "Werte ausserhalb Bereich"
.ErrorMessage = "Einseitig bla blub"
.ShowError = True
End With
ElseIf Target.value = "Einseitig" Then
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="1, 2, 3"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "Werte ausserhalb Bereich"
.ErrorMessage = "Einseitig bla blub"
.ShowError = True
End With
ElseIf Target.value = "Doppelseitig" Then
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="4, 5, 6"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "Werte ausserhalb Bereich"
.ErrorMessage = "Einseitig bla blub"
.ShowError = True
End With
ElseIf Target.value = "Halbzylinder" Then
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="7, 8, 9"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "Werte ausserhalb Bereich"
.ErrorMessage = "Einseitig bla blub"
.ShowError = True
End With
End If
Application.EnableEvents = True
End Sub
Function isMergeEmpty(rng As range) As Boolean
Dim x As String
On Error Resume Next
x = rng.value
If Err.Number <> 0 Then
isMergeEmpty = True
End If
On Error GoTo 0
End Function
Now, the main problem of our code as it was consisted in the way it was exited, in case of more then one cell. VBA has a peculiar behavior when treats a merged range having a value and *an empty such merged range, in terms of Cells.Count property. You must know that TargetCells.Count returns 1 if it refers a merged range having a value and **the number of cells in the mergeArea if it is empty. That's why the need to add Or (Target.Cells.Count > 1 And Target.MergeCells = False). To exclude from exiting cases of empty merged Target. Your code, as it was, exited on this line and the supplied function was never called.
Then, in order to avoid Target.Value = ..., which returns an error in case of an empty merged Target the checking for an empty Target must be first.
I also optimized the code in order to avoid the event to be triggered three times, instead of one.
If something still unclear, please do not hesitate to ask for clarifications. I alo commented the specific lines inside the code...
Second Edit:
I thought that you created an unmerged example only to show the different behavior against the merged one. But if you need the code to also work in such a case, another condition must be add at the end. Then, the code cam become more compact as the next one:
Private Sub Worksheet_Change(ByVal Target As range)
Dim myList As Object: Set myList = CreateObject("Scripting.Dictionary")
myList.Add "Einseitig", 1: myList.Add "Doppelseitig", 2: myList.Add "Halbzylinder", 3
Dim lengthFromCell As range, lengthToCell As range, strFormula As String
' only execute when on column F and Target.CellsCount =1 (excluding the merged Target):
If Target.Column <> 6 Or (Target.Cells.Count > 1 And Target.MergeCells = False) Then Exit Sub
Set lengthFromCell = Target.Offset(0, 1): Set lengthToCell = lengthFromCell.Offset(1, 0)
Application.EnableEvents = False
' Delete contents of "length" cells
lengthFromCell.value = "": lengthToCell.value = ""
If isMergeEmpty(Target) Then
strFormula = "0, 0, 0"
ElseIf Target.value = "Einseitig" Then
strFormula = "1, 2, 3"
ElseIf Target.value = "Doppelseitig" Then
strFormula = "4, 5, 6"
ElseIf Target.value = "Halbzylinder" Then
strFormula = "7, 8, 9"
ElseIf Target.value = "" Then 'for the case of not merged Target:
strFormula = "0, 0, 0"
End If
If strFormula <> "" Then
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=strFormula
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "Werte ausserhalb Bereich"
.ErrorMessage = "Einseitig bla blub"
.ShowError = True
End With
End If
Application.EnableEvents = True
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/358955.html