配列表示と間引き

質問

配列の間引きをを教えて下さい。
下記文を書きました
Sub 配列()

Dim u As Integer '左
Dim v As Integer '中
Dim w As Integer '右
Dim x As Integer '左
Dim y As Integer '中
Dim z As Integer '右
Dim row As Integer '行カウンタ
Dim col As Integer '列カウンタ
Dim intSheet As Integer 'シートカウンタ
Dim blnNextPage As Boolean '次シートフラグ

'初期値セット
u = 1
v = 2
w = 3
x = 4
y = 5
z = 5
row = 0
col = 1
intSheet = 1

Do While (1)

'zカウント
z = z + 1

If z > 20 Then
'zが20以上ならy+1
y = y + 1
If y > 19 Then
'yが20以上ならx+1
x = x + 1
If x > 18 Then
'xが20以上ならy+1
w = w + 1
If w > 17 Then
'wが20以上ならx+1
v = v + 1
If v > 16 Then
'wが20以上ならx+1
u = u + 1
'終了条件
If (x = 19 And y = 19 And z = 20) Then Exit Do
'v初期化 = x+1
v = u + 1
End If
'w初期化 = y+1
w = v + 1
End If
'x初期化 = x+1
x = w + 1
End If
'y初期化 = y+1
y = x + 1
End If
'z初期化 = y+1
z = y + 1
End If

If z > 20 Then Exit Sub

'行カウント
row = row + 1
If row > 1000 Then
'1000で次の列か次のページへ
If blnNextPage Then
'行・列カウンタ初期化
col = 1
row = 1
'次のシートへ
intSheet = intSheet + 1
'次のシートが無い場合は追加
If intSheet > Worksheets.Count Then
Sheets.Add After:=Worksheets(Worksheets.Count)
End If
'シートをアクティブに
Worksheets(intSheet).Select
'フラグ消去
blnNextPage = False
Else
'次の列へ
col = col + 6
row = 1
'blnNextPage = True
End If
End If

If col = 6 * 3 + 1 Then
blnNextPage = True
End If

'データ表示
Worksheets(intSheet).Range(Chr(64 + col) & row).Cells = u
Worksheets(intSheet).Range(Chr(64 + col + 1) & row).Cells = v
Worksheets(intSheet).Range(Chr(64 + col + 2) & row).Cells = w
Worksheets(intSheet).Range(Chr(64 + col + 3) & row).Cells = x
Worksheets(intSheet).Range(Chr(64 + col + 4) & row).Cells = y
Worksheets(intSheet).Range(Chr(64 + col + 5) & row).Cells = z

Loop

End Sub

上記文で表示をしますが、
６列目までの間に３列の連数字の時には表示を行わず、次に移る様にしたいのですが、どうすれば良いでしょうか？

1,2,5,6,10,12はOKです
1,2,3,5,6,10又は1,3,4,5,10,11等３連の数字は表示を行わない。

回答No.1

pkh4989

以下のように追加してみてください。

　　　　'３列の連数字チェック
　　　　If Chk_Pass(u, v, w, x, y, z) Then　　　　　　　'←追加
　　　　　　row = row - 1　　　　　　　　　　　　　　　 '←追加
　　　　Else　　　　　　　　　　　　　　　　　　　　　　'←追加
　　　　　　'データ表示
　　　　　　Worksheets(intSheet).Range(Chr(64 + col) & row).Cells = u
　　　　　　Worksheets(intSheet).Range(Chr(64 + col + 1) & row).Cells = v
　　　　　　Worksheets(intSheet).Range(Chr(64 + col + 2) & row).Cells = w
　　　　　　Worksheets(intSheet).Range(Chr(64 + col + 3) & row).Cells = x
　　　　　　Worksheets(intSheet).Range(Chr(64 + col + 4) & row).Cells = y
　　　　　　Worksheets(intSheet).Range(Chr(64 + col + 5) & row).Cells = z
　　　　End If　　　　　　　　　　　　　　　　　　　　　'←追加
　　Loop
End Sub

'３列の連数字チェック
Function Chk_Pass(u As Integer, v As Integer, w As Integer, x As Integer, y As Integer, z As Integer)
　　Dim wVal(6)　　 As Integer
　　Dim wI　　　　　As Integer
　　Dim wCnt　　　　As Integer
　　'
　　Erase wVal
　　wVal(1) = u
　　wVal(2) = v
　　wVal(3) = w
　　wVal(4) = x
　　wVal(5) = y
　　wVal(6) = z
　　'
　　wCnt = 1
　　For wI = 2 To 6
　　　　If wVal(wI - 1) + 1 = wVal(wI) Then
　　　　　　wCnt = wCnt + 1
　　　　　　If wCnt >= 3 Then
　　　　　　　　Exit For
　　　　　　End If
　　　　Else
　　　　　　wCnt = 1
　　　　End If
　　Next
　　If wCnt >= 3 Then
　　　　Chk_Pass = True
　　Else
　　　　Chk_Pass = False
　　End If
End Function

お礼

有り難うございます
出来ました