Question

我是VBA的新手并且严重陷入困境！我有12个单元格需要添加特定文本，但仅当单元格为空时。我设法找到其中一个的代码，如下所示：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$D$3" Then
        If Target.Value = "Insert name of project (if known)" Then
            Target.Font.ColorIndex = xlAutomatic
            Target.Value = ""
            Exit Sub
        End If
    End If

    If [D3].Value = "" Then
        [D3].Value = "Insert name of project (if known)"
        [D3].Font.ColorIndex = 1
    Else
        [D3].Font.ColorIndex = xlAutomatic
    End If
End Sub

然而，似乎每张纸只能使用一次。我需要与此类似的代码，希望能完成同样的工作。其余11个单元格需要有唯一的文本。

基本上我要做的是提示用户在每个单元格中插入细节，一旦单元格填满，表单就会完整。

感谢任何帮助。

嗨，抱歉道歉。这是最终编辑，完美无缺。我以为我会遇到'撤消'（CTRL + Z）的问题，但现在似乎没问题了。再次感谢。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim clls(1 To 12) As String
    Dim msg(1 To 12) As String
    Dim i As Long, addr As String, c As Range

    clls(1) = "D3": msg(1) = "Insert name of project (if known)"
    clls(2) = "D4": msg(2) = "Insert closest street address"
    clls(3) = "H3": msg(3) = "Insert name of landowner (if applicable)"
    clls(4) = "H4": msg(4) = "Insert name of Developer (if applicable)"
    clls(5) = "H6": msg(5) = "Insert name of PM Co. (if different from above)"
    clls(6) = "H7": msg(6) = "Insert name of Designer (if applicable)"
    clls(7) = "H8": msg(7) = "Insert name of Constructor"
    clls(8) = "L3": msg(8) = "Insert project number (if known)"
    clls(9) = "L6": msg(9) = "Insert name"
    clls(10) = "L7": msg(10) = "Insert submission date"
    clls(11) = "D10": msg(11) = "Brief description of project: Adjustment, deviation, main upsizing, main extension, lead-in, lead-out, etc."
    clls(12) = "D11": msg(12) = "Insert length of asset (number only)"

    Set c = Target.Cells(1)
    addr = c.Address(False, False)

    For i = 1 To UBound(clls)

        If addr = clls(i) Then
            If c.Value = msg(i) Then
                c.Font.ColorIndex = xlAutomatic
                c.Value = ""
            End If
        Else
            With Me.Range(clls(i))
                If .Value = "" Then
                    .Value = msg(i)
                    .Font.ColorIndex = 1
                End If
            End With
        End If

    Next i

End Sub

Answer 1

可能需要一些调整......

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim clls(1 To 5) As String
    Dim msg(1 To 5) As String
    Dim i As Long, addr As String, c As Range

    clls(1) = "D3": msg(1) = "Message 1"
    clls(2) = "D4": msg(2) = "Message 2"
    clls(3) = "D5": msg(3) = "Message 3"
    clls(4) = "D6": msg(4) = "Message 4"
    clls(5) = "D7": msg(5) = "Message 5"

    Set c = Target.cells(1)
    addr = c.Address(False, False)

    For i = 1 To UBound(clls)

        If addr = clls(i) Then
            If c.Value = msg(i) Then
                c.Font.ColorIndex = xlAutomatic
                c.Value = ""
            End If
        Else
            With Me.Range(clls(i))
                If .Value = "" Then
                    .Value = msg(i)
                    .Font.ColorIndex = 1
                End If
            End With
        End If

    Next i

End Sub

当单元格为空时，用于向12个单元格中的每一个插入唯一文本的VBA代码

1 个答案: