VBA检查Excel表格的所有四边中的下一个10行和10列是否为空

在VBA Excel中，如果我有一个表。 如何检查表格的所有四边，10行和10列，是否为空？

感谢Jeevan

Answer 1

你可以使用这个function：

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

你可以使用in-cell公式来做到这一点。

给定一个名为Table1的表格，它的左上angular不比K11靠左或靠左，下面的公式中， A5的值会给你答案：

  ABC 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