时间戳

首页 > 解决方案 > Excel VBA - 如何检查目标是否为命名范围。如果是，粘贴范围

excel - Excel VBA - 如何检查目标是否为命名范围。如果是，粘贴范围

问题描述

我目前将我的 excel 编码为执行以下操作：

每当在 B 列的任何位置键入各种特定的文本字符串时，将在相对偏移处粘贴相应的命名范围。

而不是在代码中键入每个触发项和相应的命名范围......有没有办法让它动态？

IF target = "ANY named range" THEN 粘贴命名范围

这是当前代码的片段。我最终的命名范围列表将不断增长，因此当命名范围列表变得太大时，此方法将不可行。维护起来会很痛苦，因此我的要求是：

**Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Application.EnableEvents = True
    If Target = "Crew_Key_Non_Prompt" Then
        Sheet1.Range("Crew_Key_Non_Prompt").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Key_Prompt" Then
        Sheet1.Range("Crew_Key_Prompt").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Key_Target" Then
        Sheet1.Range("Crew_Key_Target").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Speed" Then
        Sheet1.Range("Crew_Speed").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Speed_Overspeed" Then
        Sheet1.Range("Crew_Speed_Overspeed").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Train_Orientation" Then
        Sheet1.Range("Crew_Train_Orientation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Verbal_Confirmation" Then
        Sheet1.Range("Crew_Verbal_Confirmation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Dispatcher_Action" Then
        Sheet1.Range("Dispatcher_Action_button").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Fence_Validation" Then
        Sheet1.Range("Fence_Validation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Fence_Validation" Then
        Sheet1.Range("Fence_Validation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Set_Device" Then
        Sheet1.Range("Set_Device").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Switch_Navigation" Then
        Sheet1.Range("Train_Switch_Navigation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Target_Approach" Then
        Sheet1.Range("Train_Target_Approach").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Target_Interaction" Then
        Sheet1.Range("Train_Target_Interaction").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Timed_Movement" Then
        Sheet1.Range("Train_Timed_Movement").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
        End If
     End If
  Application.EnableEvents = True
  Application.CutCopyMode = False
 End Sub**

标签： excelvbadynamicrangenamed

解决方案

像这样的一些功能可能是可行的：

Public Function amInamedRange(myName As String, ws As Worksheet) As Boolean

    On Error GoTo amInamedRange_Error

    If ws.Range(myName) <> "" Then
    End If
    amInamedRange = True

    On Error GoTo 0
    Exit Function

amInamedRange_Error:
    amInamedRange = False
    On Error GoTo 0

End Function

以下是一些可能的用法：

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Application.EnableEvents = False
        If amInamedRange(Target.Value2, Target.Parent) Then
            Sheet1.Range(target).Copy
            Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
            Application.CutCopyMode = False
        End If
        Application.EnableEvents = True
    End If

End Sub

推荐阅读