excel 如何给不规则的不连续区域添加外边框?

dy1byipe  于 2023-01-14  发布在  其他
关注(0)|答案(1)|浏览(139)

我只想概述一个非常奇怪的不连续范围的外边界。

这里有一个工作的例子,最愚蠢的(也是唯一的)方式,我可以写这一点。

Sub test()
    Range("A1").Borders(xlEdgeBottom).Weight = xlMedium
    Range("B3").Borders(xlEdgeBottom).Weight = xlMedium
    Range("C3").Borders(xlEdgeBottom).Weight = xlMedium
    Range("D4").Borders(xlEdgeBottom).Weight = xlMedium
    
    Range("A1").Borders(xlEdgeTop).Weight = xlMedium
    Range("B2").Borders(xlEdgeTop).Weight = xlMedium
    Range("C2").Borders(xlEdgeTop).Weight = xlMedium
    Range("D3").Borders(xlEdgeTop).Weight = xlMedium
    
    Range("A1").Borders(xlEdgeLeft).Weight = xlMedium
    Range("B2").Borders(xlEdgeLeft).Weight = xlMedium
    Range("B3").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D4").Borders(xlEdgeLeft).Weight = xlMedium
    
    Range("A1").Borders(xlEdgeRight).Weight = xlMedium
    Range("C2").Borders(xlEdgeRight).Weight = xlMedium
    Range("D3").Borders(xlEdgeRight).Weight = xlMedium
    Range("D4").Borders(xlEdgeRight).Weight = xlMedium
End Sub

显然这不是我想做的。我想传递一个范围给这个Sub。
我想我可以将每个单元格添加到一个Collection对象(或者可能只是一个Range对象,后跟一个长字符串,如:Range(“A2,F6,K2:L4”))并循环遍历该集合,检查相邻单元格是否是该集合的一部分,如果不是,则放置边框。
任何帮助感激不尽!

cwdobuhd

cwdobuhd1#

这个适合您的需要吗?
这个适合您的需要吗?

Sub Test()
    DrawBorderAroundSelection Range("A1,B2:C3,D3:D4"), xlMedium
End Sub
 
Sub DrawBorderAroundSelection(rngShape As Range, lineweight)

    For Each c In rngShape.Cells
    
        If c.Column = c.Parent.Columns.Count Then
            c.Borders(xlEdgeRight).Weight = lineweight
        ElseIf Intersect(c.Offset(0, 1), rngShape) Is Nothing Then
            c.Borders(xlEdgeRight).Weight = lineweight
        End If
        
        If c.Row = c.Parent.Rows.Count Then
            c.Borders(xlEdgeBottom).Weight = lineweight
        ElseIf Intersect(c.Offset(1, 0), rngShape) Is Nothing Then
            c.Borders(xlEdgeBottom).Weight = lineweight
        End If
        
        If c.Column = 1 Then
            c.Borders(xlEdgeLeft).Weight = lineweight
        ElseIf Intersect(c.Offset(0, -1), rngShape) Is Nothing Then
            c.Borders(xlEdgeLeft).Weight = lineweight
        End If
        
        If c.Row = 1 Then
            c.Borders(xlEdgeTop).Weight = lineweight
        ElseIf Intersect(c.Offset(-1, 0), rngShape) Is Nothing Then
            c.Borders(xlEdgeTop).Weight = lineweight
        End If
        
    Next
    
End Sub

相关问题