共通の値を持つ座標の組み合わせについて

質問

• 共通の値を持つ座標の組み合わせを表示するVBAの作成方法について考えています。
• 表の特定の座標に共通の値を持つ組み合わせを表示するVBAを作成したいです。
• VBAに詳しい方からのアドバイスを頂けると助かります。

回答No.5

nag0720

改良版のプログラムです。

１００×１００で実行する場合は、SIZEを100に変更してください。
組み合わせ結果は随時、Sheet2に出力されますので、プログラムの実行はコード画面からではなく、シート画面のツールメニューの「マクロ」から実行してください。
また、シート画面下段のステータスバー領域に途中経過を表示していますから、ステータスバーを表示状態にしておいてください。

スピード重視でコーディングしているので前より速くなっているはずですが、１００×１００ではどのくらい時間が掛かるか見当もつきません。
もしこれでだめだったら、他の言語で作るしかないでしょう。

Option Explicit
Option Base 1

Const SIZE = 10
Dim C(SIZE, SIZE) As Boolean
Dim TBL(SIZE, 10000) As Boolean
Dim Count As Integer
Dim S(SIZE) As Integer
Dim SS As String

Sub Combination()
Dim i As Integer, j As Integer

For i = 1 To SIZE - 1
For j = i + 1 To SIZE
C(i, j) = Cells(i + 1, j + 1)
Next
Next

Worksheets("Sheet2").Select
Count = 0
For i = 1 To SIZE - 1
S(1) = i
AddCombin 1, i
S(1) = 0
Next
Application.StatusBar = "完了"
End Sub

Sub AddCombin(n As Integer, k As Integer)
Dim i As Integer, j As Integer
Dim ExistNext As Boolean, CheckFlag As Boolean

ExistNext = False
For j = k + 1 To SIZE
CheckFlag = True
For i = 1 To n
If Not C(S(i), j) Then
CheckFlag = False
Exit For
End If
Next
If CheckFlag Then
ExistNext = True
S(n + 1) = j
AddCombin n + 1, j
S(n + 1) = 0
End If
Next
If n = 1 Or ExistNext Then Exit Sub

SS = ""
For i = 1 To n
SS = SS & " " & S(i)
Next
Application.StatusBar = "処理中:" & SS

For j = 1 To Count
CheckFlag = True
For i = 1 To n
If Not TBL(S(i), j) Then
CheckFlag = False
Exit For
End If
Next
If CheckFlag Then Exit Sub
Next

Count = Count + 1
For j = 1 To SIZE
TBL(j, Count) = False
Next
For i = 1 To n
TBL(S(i), Count) = True
Worksheets("Sheet2").Cells(Count + 1, i + 1) = S(i)
Next
Worksheets("Sheet2").Cells(Count + 1, 2).Select
End Sub