另类的双击事件，划边框，谢谢过客fppt和山菊花和cidanji老师！

lhj323323

cidanji 发表于 2023-12-13 17:07

看来，仍是EXCEL版本问题。
18的附件，双击后，横向边框仍是黑色的。

lhj323323

过客fppt 发表于 2023-12-13 17:02
我的是win10系统，用WPS写的

谢谢过客老师！
我的电脑太脆弱，不敢安装WPS和EXCEL（2003以上的版本）
给您添麻烦了，再次感谢老师！

cidanji

可能是版本，255赋值颜色就应该是红的，不行你把箭头2句分别前后互换如图位置试试

lhj323323

cidanji 发表于 2023-12-13 16:56
传不了附件

果然，把那两句对调，就正确了！

cidanji

lhj323323 发表于 2023-12-13 18:20

2者合一起了，x=7时左边线，9时下边线

lhj323323

cidanji 发表于 2023-12-13 18:22
2者合一起了，x=7时左边线，9时下边线

谢谢老师指点！

lhj323323

山菊花 发表于 2023-12-13 16:30
右键点击工作表标签，将下面的代码粘贴到VBE窗口光标处，然后返回工作表。

版主老师：
刚才发的附件（AB相融合的），您不必回复我了。
现在已搞定了。
再次感谢老师！

yizhimoshou

Dim hbk As Boolean

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Rng As Range
    Cancel = True
   
    ' 检查是否在第一行或第一列双击
    If Target.Row = 1 Or Target.Column = 1 Then Exit Sub
   
    ' 如果 hbk 为 False，则表示第一次双击，清除所有单元格的边框
    If Not hbk Then
        hbk = True
        UsedRange.Borders.LineStyle = 0
    End If
   
    ' 检查目标单元格是否为空
    If Target.Value = "" Then
        ' 如果目标单元格为空，找到相邻非空单元格
        Set Rng = Target.End(xlDown)
        
        ' 如果找不到非空单元格，将 hbk 设置为 False，并选择下一列
        If Rng.Value = "" Then
            hbk = False
            Set Rng = Target.Offset(0, 1)
        Else
            ' 如果找到非空单元格，递归调用双击事件处理该单元格
            Worksheet_BeforeDoubleClick Rng, True
        End If
        
        ' 设置单元格范围的上边框样式
        With Range(Target.Offset(-1), Rng.Offset(-1, -1)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Color = RGB(255, 0, 0) ' 红色
            .Weight = xlThick
        End With
    Else
        ' 如果目标单元格非空，设置目标单元格的左边框样式
        With Target.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Color = RGB(255, 0, 0) ' 红色
            .Weight = xlThick
        End With
        
        ' 递归调用双击事件处理下一行的单元格
        Worksheet_BeforeDoubleClick Target.Offset(1), True
    End If
End Sub