Excelテーブルの4辺の次の10行と10列が空であるかどうかを確認します。

Question

VBA Excelでは、テーブルがある場合。どのようにして、テーブルの外側にある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" 

もう一つの例：

Dim num As Long 

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

Answer 2

これは、セル内の式で行うことができます。

は左上隅がK11よりトップへ左へのより近くではありませんし、次の式Table1という名前のテーブルを考えると、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