'(VB) Constructing and counting fill matrices
Const nmax = 6
'computing time increases strongly with nmax
Const c = 36 '>= nmax * (nmax + 1) / 2:
             'maximum number of matrix elements
Dim nr(c), ri(c), le(c), up(c)
' see structure
Dim smax 'number of matrix elements
Dim aa(c) 'terms of the sequence

Sub main_program()
'matrices are encoded as strings of length n*(n+1)/2
'The k-th element in the m-th row is placed in the
'position number k+m*(m-1)/2 of the string.
Erase aa()
prot$ = "1," 'the sequence as a string
For n = 2 To nmax
  pro$ = "" 'the matrix as a string
  smax = n * (n + 1) / 2
  Call structure(n)
  Do
    Call create_matrix(pro$, n)
    If pro$ = "" Then Exit Do
    Call check_matrix((pro$), n, ok)
    If ok Then aa(n) = aa(n) + 1
  Loop
  prot$ = prot$ + Str(aa(n))
  If n < nmax Then prot$ = prot$ + ","
Next
Cells(1, 1).Value = prot$ 'output Excel
End Sub

Sub structure(n)
For m = 1 To n
  b = (m * (m + 1)) \ 2 'last element of row number m
  a = b - m + 1         'first element of row number m
  For s = a To b
    's is the position in the string
    nr(s) = m       'number of the row in the matrix
    ri(s) = (s > a) 'false if s is the first element
    le(s) = (s < b) 'false if s is the last element
    up(s) = (m < n) 'false if s is in the last row
  Next
Next
End Sub

Sub create_matrix(pro$, n)
'strings of length n*(n+1)/2 with n "1"-terms are created

If pro$ = "" Then
  pro$ = String(smax - n, "0") + String(n, "1")
Else
  s = InStr(pro$, "1")
  If s > 1 Then
    Mid(pro$, s - 1, 2) = "10"
  Else
    s2 = InStr(pro$, "01")
    If s2 = 0 Then pro$ = "": Exit Sub
    s1 = InStr(pro$, "0")
    h$ = String(s2 - s1, "0") + String(s1, "1") + "0"
    Mid(pro$, 1, s2 + 1) = h$
  End If
End If
End Sub

Sub check_matrix(pro$, n, ok)
'It is checked if each "0" can be replaced by "1"

Do Until InStr(pro$, "0") = 0
  chg = False
  s = 0
  Do
    s = InStr(s + 1, pro$, "0")
    If s = 0 Then Exit Do
    ok = False
    If up(s) Then ok = check_triple(pro$, n, s, nr(s), nr(s) + 1, chg)
    If Not ok And ri(s) Then ok = check_triple(pro$, n, s, -1, -nr(s), chg)
    If Not ok And le(s) Then ok = check_triple(pro$, n, s, 1, 1 - nr(s), chg)
  Loop
  If Not chg Then Exit Sub
Loop
End Sub

Function check_triple(pro$, n, s, t1, t2, chg)
'The replacement is checked and done if possible

ok = (Mid(pro$, s + t1, 1) + Mid(pro$, s + t2, 1) = "11")
If ok Then chg = True: Mid(pro$, s, 1) = "1"
check_triple = ok
End Function