雙擊在合併單元格上插入字符

Question

我想通過雙擊在特定範圍（「A1：A19」）內的單元格內插入或移除「X」。下面的代碼放置在項目宏中的「Microsoft Excel Objects \ ThisWorkbook」上。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 
    If Not Intersect(Target, Range("A1:A19")) Is Nothing Then 
     If Len(Trim(Target)) = 0 Then 
      Target.Value = "X" 
      Cancel = True 
     ElseIf UCase(Trim(Target)) = "X" Then 
      Target.ClearContents 
      Cancel = True 
     End If 
    End If 
End Sub 

此代碼適用於非合併單元格。不過，我在那裏的細胞必須（由2 2列）合併的情況，在這種情況下，我得到以下錯誤：

「運行時錯誤‘13’」 類型不匹配

如何修改代碼以防止這種情況發生？

Answer 1

嘗試

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 
    If Not Intersect(Target, Range("A1:A19")) Is Nothing Then 
     If Target.Cells.Count = 1 Then ' handle single cell 
      If Len(Trim(Target)) = 0 Then 
       Target.Value = "X" 
       Cancel = True 
      ElseIf UCase(Trim(Target)) = "X" Then 
       Target.ClearContents 
       Cancel = True 
      End If 
     Else ' handle merged 
      Dim theAddress As String 
      theAddress = Split(Target.Address, ":")(0) & ":" & Split(Target.Address, ":")(0) 
      If Len(Trim(Range(theAddress))) = 0 Then 
       Target.Value = "X" 
       Cancel = True 
      ElseIf UCase(Trim(Range(theAddress))) = "X" Then 
       Target.ClearContents 
       Cancel = True 
      End If 
     End If 
    End If 
End Sub 

Answer 2

當你的細胞被合併，目標是返回一個範圍內的多個細胞，它是試圖把一個值到細胞中，這不能把值代入。試試這個：

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 

Dim myRange As Range 

Set myRange = Target.Cells(1, 1) 

If Not Intersect(myRange, Range("A1:A19")) Is Nothing Then 
    If Len(Trim(myRange)) = 0 Then 
     myRange.Value = "X" 
     Cancel = True 
    ElseIf UCase(Trim(myRange)) = "X" Then 
     Target.ClearContents 
     Cancel = True 
    End If 
End If 
End Sub 

它返回一個參考範圍爲在合併範圍的左上角單元格，並允許您進入基於該值。