VBA 检查 Excel Table 的所有 4 边接下来的 10 行和 10 列是否为空

Question

在VBAExcel，如果我有一个table。如何检查 table 之外所有 4 边的单元格，对于 10 行和 10 列，是否为空？

谢谢杰文

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"

另一个名为 table 的示例：

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 的 table，其左上角不比 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

这里我有一些东西适用于任何命名的 table，只要它的第一个单元格离边缘不比 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

VBA 检查 Excel Table 的所有 4 边接下来的 10 行和 10 列是否为空

VBA check if next 10 rows and 10 columns in all 4 sides of a Excel Table is empty

excel

vba

excel-2013