VBA代碼插入獨特的文本到12個單元格中的每一個，當單元格爲空時

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