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

Question

我是 VBA 的新手，严重卡住了！我有 12 个单元格需要添加特定文本，但前提是单元格为空。我设法找到了其中 1 个的代码，如下所示：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$D" 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

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

基本上我想做的是提示用户在每个单元格中插入详细信息，一旦单元格填满，表格就会完成。

感谢任何帮助。

您好，抱歉耽误了时间。这是最终的编辑，效果很好。我以为 'undo' (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

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

VBA code for inserting unique text to each of 12 cells, when cells are blank

excel

vba