如何将外部边框添加到不规则的不连续范围？

Question

I would like to outline only the outside border of a very strange noncontiguous range.

Here's a working example of the stupidest (and only) way I can write this.

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

Obviously this is not what I want to do. I would like to pass a range to this Sub.

I think I could add each cell to a Collection object (Or maybe just a Range object followed by a long string like: Range("A2, F6, K2:L4") ) and loop through the Collection, checking if neighboring cells are part of that Collection, and if not, placing a border.

Any help appreciated!

Answer 1

Does this suit your needs?

Does this suit your needs?

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