Question

温柔的家伙，我不是程序员。

许多月以前，我从互联网上获得了这些代码。我会赞美，但我不记得它来自哪里。

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Static xRow
Static xColumn
If xColumn <> "" Then
With Columns(xColumn)
.Interior.ColorIndex = xlNone
End With
With Rows(xRow)
.Interior.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn)
.Interior.ColorIndex = 19
.Interior.Pattern = xlSolid
End With
With Rows(pRow)
.Interior.ColorIndex = 19
.Interior.Pattern = xlSolid
End With
End Sub

以上代码突出显示所选卖出的行和列。问题是它突出显示从1到1048576的列，这会导致垂直滚动条变小。另外，如果电子表格中有任何颜色编码，它会将其搞砸。我决定写自己的荧光笔。我在选定的行，列周围放置了一个边框，只对500行进行了操作。它几乎可以工作。问题是我的代码中的某些内容取消了复制命令，并且不允许我粘贴，这在上面的代码中没有发生。复制/粘贴是必须的。任何帮助将不胜感激。

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Range("A1:N500").Borders(xlEdgeLeft).Weight = xlThin
Range("A1:N500").Borders(xlEdgeTop).Weight = xlThin
Range("A1:N500").Borders(xlEdgeBottom).Weight = xlThin
Range("A1:N500").Borders(xlEdgeRight).Weight = xlThin
Range("A1:N500").Borders(xlInsideVertical).Weight = xlThin
Range("A1:N500").Borders(xlInsideHorizontal).Weight = xlThin
Range("A1:N500").Borders(xlEdgeLeft).Color = vbBlack
Range("A1:N500").Borders(xlEdgeTop).Color = vbBlack
Range("A1:N500").Borders(xlEdgeBottom).Color = vbBlack
Range("A1:N500").Borders(xlEdgeRight).Color = vbBlack
Range("A1:N500").Borders(xlInsideVertical).Color = vbBlack
Range("A1:N500").Borders(xlInsideHorizontal).Color = vbBlack
Dim SplitAddress() As String
SplitAddress = Split(ActiveCell.Address, "$")
Dim RowSelection As String
RowSelection = "A" & SplitAddress(2) & ":" & "N" & SplitAddress(2)
Dim ColSelection As String
ColSelection = SplitAddress(1) & "1" & ":" & SplitAddress(1) & "500"
With Range(RowSelection)
.BorderAround Weight:=xlThick, Color:=RGB(255, 0, 0)
End With
With Range(ColSelection)
.BorderAround Weight:=xlThick, Color:=RGB(255, 0, 0)
End With
End Sub

Answer 1

试试这个。

正在进行中

它从工作表

中的最后一个单元格复制格式，作为默认格式

代码不使用复制/粘贴来执行边框

我仍在处理您遇到问题的单元格之间的复制/粘贴

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.ScreenUpdating = False

    Dim aaa As DisplayFormat
    Set aaa = Range("XFD1048576").DisplayFormat   ' copy format from very last cell (it is a cheat)

    Range("A1:N500").Borders.Color = aaa.Borders.Color          ' revert border color to its default
    Range("A1:N500").Borders.LineStyle = aaa.Borders.LineStyle

    Dim i As Integer
    For i = xlEdgeLeft To xlEdgeRight   ' loop the four outside borders (7 to 10)
        Target.EntireRow.Resize(1, 8).Borders.Item(i).Color = vbRed
        Target.EntireRow.Resize(1, 8).Borders.Item(i).Weight = xlThick

        Target.EntireColumn.Resize(500, 1).Borders.Item(i).Color = vbRed
        Target.EntireColumn.Resize(500, 1).Borders.Item(i).Weight = xlThick

    Next i

    Application.ScreenUpdating = True

End Sub

突出显示所选单元格的行列

1 个答案: