如何清除除 X、Y 和 Z 列和 A、B、C 行之外的所有数据？

Question

I have seen this very similar question, and I think the answer by user @SQL Police is great! But I can not figure out how to modify or adapt it to produce the results I am looking for. Here is my (similar, but different) question:

I want to delete everything that is NOT in columns 24 - 26, but also not in rows 1 - 6.

I have code that can do each seperately, but not together.

To delete with specified columns:

Sub ColClear()
Dim ws As Worksheet
Set ws = ActiveSheet

ws.Range(ws.Columns(1), ws.Columns(23)).ClearContents
ws.Range(ws.Columns(27), ws.Columns(ws.UsedRange.End(xlToRight).Column)).Clear

End Sub

To delete with specified rows:

Sub RowClear()
With Sheets("SheetName")
.Rows(7 & ":" & .Rows.Count).ClearContents
End With
End Sub

But how can I do both at once? (The intersection of the two ranges, not the union)

Thanks!

Answer 1

Adapt to your requirement, the basic idea is to get the range of both sides then ClearContents separately:

Option Explicit

Private Sub Test()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    With ws
        Dim bottomLeftRng As Range
        Set bottomLeftRng = .Range(.Cells(7, 1), .Cells(.Rows.Count, 23))
        
        Dim bottomRightRng As Range
        Set bottomRightRng = .Range(.Cells(7, 27), .Cells(.Rows.Count, .Columns.Count))
    End With
    
    bottomLeftRng.ClearContents
    bottomRightRng.ClearContents
End Sub

Answer 2

It is a pity that the Excel VBA object model does not provide a Difference() function to complement the included Union() and Intersect() functions.

If it did your task would be as simple as this:

With Difference(ws.[x:z], ws.[1:6])
    .ClearContents
End With

---

So, let's make a Difference() function that you can call with the above snippet:

Function Difference(r1 As Range, r2 As Range) As Range
    
    Dim x1&, x2&, x3&, x4&
    Dim y1&, y2&, y3&, y4&
    Dim a&, rBox As Range, rUni As Range, rInt As Range
    
    Set rInt = Intersect(r1, r2)
    Set rUni = Union(r1, r2)
    Set rBox = rUni.Areas(1)
    
    For a = 2 To rUni.Areas.Count
        Set rBox = Range(rBox, rUni.Areas(a))
    Next
    
    x1 = rBox.Column
    x2 = rInt.Column - 1
    x3 = rInt.Column + rInt.Columns.Count
    x4 = rBox.Column + rBox.Columns.Count - 1

    y1 = rBox.Row
    y2 = rInt.Row - 1
    y3 = rInt.Row + rInt.Rows.Count
    y4 = rBox.Row + rBox.Rows.Count - 1
    
    Set rUni = Range(Cells(y3, x3), Cells(y4, x4))
    If y2 Then Set rUni = Union(rUni, Range(Cells(y1, x3), Cells(y2, x4)))
    If x2 Then Set rUni = Union(rUni, Range(Cells(y3, x1), Cells(y4, x2)))
    If y2 > 0 And x2 > 0 Then Set rUni = Union(rUni, Range(Cells(y1, x1), Cells(y2, x2)))
    
    Set Difference = rUni
            
End Function

I believe this solves the general case of preserving the contents of the intersection and union of two ranges while clearing everything else.

---

It also works for smaller ranges, clearing only the corner areas within the box that tightly surrounds the union:

With Difference(ws.[a9:ba11], ws.[v3:z25])
    .ClearContents
End With