2017-02-21 1678 views
0

我有一个代码可以做2件事:首先它将来自数据验证删除列表的项目排列在图2中,并用“,”表示位于表单中的单元格的所需范围同样,如果用户选择相同的项目,它将从选定的单元格中删除它。VBA excel Target.Address =单元格范围

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

在下面的代码工作几乎完美因为,它只有当我请从期望范围内的单细胞缩放:

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.Adress如何选择全范围D2:F325

在此先感谢

+0

你在代码开始时有这行 - 如果Target.Count> 1 Then GoTo exitHandler',如果你选择多于1个单元格,你退出你的'Sub' –

回答

0
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 

它工作得很好。