VBA excel Target.Address = 单元格范围
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/42367584/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA excel Target.Address = Range of Cells
提问by O.k
I have code to do 2 things: first of all it sorts items from data validation drop lists which is located in Sheet 2 with "," to desired range of cells located in Sheet 1. Also,if user selects the same item, it deletes it from selected cell.
我有代码可以做两件事:首先,它将位于工作表 2 中的数据验证下拉列表中的项目排序为“,”到工作表 1 中所需的单元格范围。此外,如果用户选择相同的项目,它会删除它来自选定的单元格。
The other option of code is when user selects the cells of dropdown lists(which is located in D2:F325it should zoom in 100%to see the items on the lists(cause its font sizes are too small to see)
代码的另一个选项是当用户选择下拉列表的单元格时(位于其中的单元格D2:F325应该放大 100%以查看列表中的项目(因为它的字体太小而无法看到)
In the below code works almost perfectly. Because, it only zooms when i select a single cell from the desired range:
在下面的代码中几乎完美地工作。因为,它仅在我从所需范围中选择单个单元格时才会缩放:
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
XYZis the name of cell D2cause i tried to named this range to select with this function but it did not work.
XYZ是单元格的名称,D2因为我试图命名此范围以使用此功能进行选择,但它不起作用。
Finally, how Target.Addresscan select whole range D2:F325
最后,如何Target.Address选择整个范围D2:F325
采纳答案by O.k
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
It works pretty well.
它工作得很好。

