首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >VBA excel Target.Address =单元格范围

VBA excel Target.Address =单元格范围
EN

Stack Overflow用户
提问于 2017-02-21 20:38:30
回答 1查看 38.3K关注 0票数 2

我有两件事要做的代码:首先,它用",“将位于工作表2中的数据验证下拉列表中的项排序到位于工作表1中的所需单元格范围。此外,如果用户选择相同的项,它会将其从选定的单元格中删除。

代码的另一种选择是当用户选择下拉列表的单元格时(位于D2:F325中),它应该放大100%以查看列表上的项目(因为它的字体太小而看不见)

在下面的代码中几乎可以完美地工作。因为,只有当我从所需范围中选择单个单元格时,它才会缩放:

代码语言:javascript
运行
复制
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then GoTo exitHandler

    If Target.Address = Range("XYZ").Address Then
        ActiveWindow.Zoom = 100
        [A5000] = "zoomed"
        ElseIf [A5000] = "zoomed" Then
        'Otherwise set the zoom to original
        ActiveWindow.Zoom = 70
        [A5000].ClearContents
    End If

exitHandler:
    Application.EnableEvents = True
End Sub


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

    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

XYZ是单元格D2的名称,因为我尝试使用此函数命名此范围以进行选择,但它不起作用。

最后,Target.Address如何选择全范围D2:F325

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2017-02-21 21:42:10

代码语言:javascript
运行
复制
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then GoTo exitHandler

 If Not Application.Intersect(Target, Range("D2:F325")) Is Nothing Then
   ActiveWindow.Zoom = 100
   [A5000] = "zoomed"
 ElseIf [A5000] = "zoomed" Then
 'Otherwise set the zoom to original
ActiveWindow.Zoom = 70
[A5000].ClearContents
End If

 exitHandler:
  Application.EnableEvents = True
End Sub

它工作得很好。

票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/42367584

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档