2017-02-21 2 views
0

두 가지 작업을 수행하는 코드가 있습니다. 먼저 시트 2에있는 데이터 유효성 검사 드롭 목록의 항목을 시트에있는 원하는 셀 범위의 ","로 정렬합니다 1. 또한 사용자가 동일한 항목을 선택하면 선택한 셀에서 삭제됩니다.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

코드의 시작 부분에이 줄이 있습니다. If Target.Count> 1 Then GoTo exitHandler', 둘 이상의 셀을 선택하면 '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 

에서

감사를 꽤 잘 작동합니다.