双击在合并单元格上插入字符

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 

它返回一个参考范围为在合并范围的左上角单元格，并允许您进入基于该值。