Excel VBA缩放范围

在上述代码中，如果Target.Address=“$D$2:$F$861”，则不起作用

我想在用户选择D2:F861时放大

当我输入像

$A$2

这样的单单元格地址时，它会工作

请帮助我，当用户选择此区域时，缩放更改为100%，否则将保持70%，或者其他选项将保持用户设置的缩放

---

这实际上不是范围比较。即使您从带有逗号的下拉列表中选择所需单元格，它也会添加新值

然而，如果我们不能从下拉列表中获得更大的字体。我想添加一些代码来缩放，同时选择有下拉列表的单元格

---

完整代码如下：

If Target.Address = "$D$2:$F$861" Then

    ActiveWindow.Zoom = 100
    [A5000] = "zoomed"
ElseIf [A5000] = "zoomed" Then
     'Otherwise set the zoom to original
    ActiveWindow.Zoom = 70
    [A5000].ClearContents 
End If

---

要知道

Target

是否在所需范围内，您可以使用以下命令进行测试：

如果不是Application.Intersect（目标，Me.Range（$D$2:$F$861）），则什么都不是

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler



 If Target.Address = "$D$2:$F$861" Then

    ActiveWindow.Zoom = 100
    [A5000] = "zoomed"
ElseIf [A5000] = "zoomed" Then
     'Otherwise set the zoom to original
    ActiveWindow.Zoom = 70
    [A5000].ClearContents
End If

lType = Target.Validation.Type
If lType = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal





    If oldVal = "" Then
        'do nothing
    Else
        If newVal = "" Then
            'do nothing
        Else
            On Error Resume Next
            Ar = Split(oldVal, ", ")
            strVal = ""
            For i = LBound(Ar) To UBound(Ar)
                Debug.Print strVal
                Debug.Print CStr(Ar(i))
                If newVal = CStr(Ar(i)) Then
                    'do not include this item
                    strVal = strVal
                    lCount = 1
                Else
                    strVal = strVal & CStr(Ar(i)) & ", "
                End If
            Next i
            If lCount > 0 Then
                Target.Value = Left(strVal, Len(strVal) - 2)
            Else
                Target.Value = strVal & newVal
            End If
        End If
    End If

End If

exitHandler:
  Application.EnableEvents = True
End Sub

“不起作用”是什么意思？你有错误吗？你调试过了吗？这个条件从来没有满足过吗？
如果不相交（目标，范围（$D$2:$F$861）），那就什么都不是了
@SJR:I也很难，但这只会说明目标是否在范围内。@TimWilkinson不工作意味着我调试过，但什么都没有发生。如果目标=Me.range（$D$2:$F$861）），也没有错误然后

应该可以工作了。即使我真的看不到缩放的意义…如果Target=Me.Range（$D$2:$F$861”），那么命令行返回错误。运行时错误“13”类型不匹配错误。不过，感谢您对整个代码进行简化和除法。@好的，所以您必须坚持使用

。地址
，尝试编辑！；）。地址不起作用。但是，工作表更改有效，缩放无效working@O.k你有错误吗？还是什么都没发生？你选择了整个范围吗？没有，我没有错误，但我没有选择整个范围。我所要做的就是，如果我从这个范围代码中选择任何单元格，则不需要缩放来选择整个范围。
 Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler


MsgBox "In event"

If Not Application.Intersect(Target, Me.Range("$D$2:$F$861")) Is Nothing Then
    MsgBox "In range"
    ActiveWindow.Zoom = 100
    Me.[A5000] = "zoomed"
Else
    If Me.[A5000] = "zoomed" Then
         'Otherwise set the zoom to original
        ActiveWindow.Zoom = 70
        Me.[A5000].ClearContents
    Else
    End If
End If


MsgBox "Check validation"
lType = Target.Validation.Type
If lType = 3 Then
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If oldVal = vbNullString Then
        'do nothing
    Else
        If newVal = vbNullString Then
            'do nothing
        Else
            On Error Resume Next
            Ar = Split(oldVal, ", ")
            strVal = vbNullString
            For i = LBound(Ar) To UBound(Ar)
                Debug.Print strVal
                Debug.Print CStr(Ar(i))
                If newVal = CStr(Ar(i)) Then
                    'do not include this item
                    strVal = strVal
                    lCount = 1
                Else
                    strVal = strVal & CStr(Ar(i)) & ", "
                End If
            Next i
            If lCount > 0 Then
                Target.Value = Left(strVal, Len(strVal) - 2)
            Else
                Target.Value = strVal & newVal
            End If
        End If
    End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub