excel - Excel VBA，用于根据用户选择设置特定单元格值

Question

在这里寻求帮助以提高我的 VBA 代码的效率。不知道如何设置它，如果我在 B 中有 10 行（B5 到 B10），它将自动填充：

• 如果 B 的值为 1，则该行的 D 列，
• 如果 B 的值为 2，则更新 D 和 E，
• 如果 B 的值为 3，则更新 D、E 和 F

无需在代码本身中逐行手动指定

例子：

- 如果我将 B9 的值设置为 2，它将填充单元格 D9 和 E9 的值

- 如果我将 B6 的值设置为 1，它将填充单元格 D6 的值

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5")) Is Nothing Then
    Select Case Target.Value
        Case Is = 1
            Range("D5").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Is = 2
            Range("D5").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("E5").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Is = 3
            Range("D5").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("E5").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("F5").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Else
            Range("D5:F5").Value = ""
    End Select
End If
If Not Intersect(Target, Range("B6")) Is Nothing Then
    Select Case Target.Value
        Case Is = 1
            Range("D6").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Is = 2
            Range("D6").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("E6").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Is = 3
            Range("D6").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("E6").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("F6").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Else
            Range("D6:F6").Value = ""
    End Select
End If
If Not Intersect(Target, Range("B7")) Is Nothing Then
    Select Case Target.Value
        Case Is = 1
            Range("D7").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Is = 2
            Range("D7").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("E7").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Is = 3
            Range("D7").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("E7").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
            Range("F7").Value = "• Course Name:" & vbNewLine & "• No. Of Slides Affected:" & vbNewLine & "• No. of Activities Affected:"
        Case Else
            Range("D7:F7").Value = ""
    End Select
End If
End Sub

标签： excelvba

Answer 1

如果我了解您要做什么，也许以下使用Resize和Target.Row

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge <> 1 Then Exit Sub

    If Not Intersect(Target, Me.Range("B5:B10")) Is Nothing Then
        Dim rw As Long
        rw = Target.Row

        Dim txt As String
        txt = "• Course Name:" & vbNewLine & _
              "• No. Of Slides Affected:" & vbNewLine & _
              "• No. of Activities Affected:"

        Select Case Target.Value
            Case 1 To 3
                Me.Range("D" & rw).Resize(, Target.Value).Value = txt
            Case Else
                Me.Range("D" & rw & ":F" & rw).Value = ""
        End Select
    End If

End Sub