VBA检查Excel表的所有4个侧面的下一个10行和10列都是空的

Question

在vba excel中，如果我有一个表。如何在其所有4个侧面的桌子外面检查10行和10列的单元格？

谢谢jeevan

Answer 1

您可以使用此功能：

Option Explicit
Function NonBlankCellsOutside(rng As Range, rowsOutside As Long, colsOutside As Long)
    Dim outside As Range
    Dim rowsBefore As Long
    Dim colsBefore As Long
    rowsBefore = IIf(rng.Row <= rowsOutside, rng.Row - 1, rng.Row - rowsOutside)
    colsBefore = IIf(rng.Column <= colsOutside, rng.Column - 1, rng.Column - colsOutside)
    Set outside = rng.Offset(-rowsBefore, -colsBefore) _
                     .Resize(rng.Rows.Count + rowsBefore + rowsOutside, _
                             rng.Columns.Count + colsBefore + colsOutside)
    NonBlankCellsOutside = WorksheetFunction.CountA(outside) _
                         - WorksheetFunction.CountA(rng)
End Function

示例与普通范围一起使用：

Dim ok As Boolean
ok = NonBlankCellsOutside(Worksheets(1).Range("C20:F50"), 10, 10) = 0
If Not ok Then MsgBox "There are non-blank cells in the neighbourhood"

带有名称表的另一个示例：

Dim num As Long
num = NonBlankCellsOutside(ActiveSheet.ListObjects("Table1").Range, 5, 5)
MsgBox "There are " & num & " non-blank cells around the table"

Answer 2

您可以使用单元格公式进行此操作。

给出了一个名为Table1的表，其上左上角不到顶部或左侧的表，而不是K11，并且以下公式，A5中的值将为您提供答案：

    A           B                           C
1
2 Range start   =ROW(Table1)-10             =COLUMN(Table1)-10
3 Range end     =ROW(Table1)+ROWS(Table1)+9 =COLUMN(Table1)+COLUMNS(Table1)+9
4
5 =AND(B2>0, B3>0, COUNTA(INDIRECT("r"&B2&"c"&C2&":r"&B3&"c"&C3, FALSE))=COUNTA(Table1[#All]))

Answer 3

在这里，我有适合任何命名表的东西，只要它的第一个单元格与边缘更近，而不是K11。

Sub checkSurroundings()
Dim tws As Worksheet
Dim tb1 As ListObject
Dim tb1_address As String
Dim c() As String               'Table range, first and last cell
Dim rngL, rngR, rngU, rngD As Range
Dim tmpRange As Range
Dim cnt As Integer

    Set tws = ThisWorkbook.Worksheets("Sheet1")
    Set tb1 = tws.ListObjects("Table1")
    tb1_address = tb1.Range.Address
    'Debug.Print tb1_address
    c() = Split(tb1_address, ":", -1, vbTextCompare)
    'Debug.Print c(0)
    'Debug.Print c(1)
    cnt = 0
    With tws
        'Range Left
        Set rngL = Range(.Range(c(0)).Offset(-10, -10), .Cells(.Range(c(1)).Row + 10, .Range(c(0)).Column - 1))
        'Range Right
        Set rngR = Range(.Cells(.Range(c(0)).Row - 10, .Range(c(1)).Column + 1), .Range(c(1)).Offset(10, 10))
        'Range Up
        Set rngU = Range(.Range(c(0)).Offset(-10, 0), .Cells(.Range(c(0)).Row - 1, .Range(c(1)).Column))
        'Range Down
        Set rngD = Range(.Cells(.Range(c(1)).Row + 1, .Range(c(0)).Column), .Range(c(1)).Offset(10, 0))
    End With

    For i = 1 To 4
        Select Case i
            Case 1
            Set tmpRng = rngL
            Case 2
            Set tmpRng = rngR
            Case 3
            Set tmpRng = rngU
            Case 4
            Set tmpRng = rngD
        End Select

        For Each cell In tmpRng
            If Not IsEmpty(cell) Then
                cnt = cnt + 1
            End If
        Next cell
    Next i
    If cnt > 0 Then
        MsgBox ("The area around Table1 (+-10) is not empty. There are " & cnt & " non-empty cells.")
    Else
        MsgBox ("The area around Table1 (+-10) is empty.")
    End If

End Sub