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

質問

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

回答No.6

nag0720

訂正です。
たいした違いはないとは思うけれど、こっちのほうが少し速くなるかもしれません。

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 T(SIZE) As Integer
Dim TCount 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
TCount = 0
For j = i + 1 To SIZE
If C(i, j) Then
TCount = TCount + 1
T(TCount) = j
End If
Next
S(1) = i
AddCombin 1, 1
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 To TCount
CheckFlag = True
For i = 1 To n
If Not C(S(i), T(j)) Then
CheckFlag = False
Exit For
End If
Next
If CheckFlag Then
ExistNext = True
S(n + 1) = T(j)
AddCombin n + 1, j + 1
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

お礼

ご丁寧にアドバイスをいただきまして本当にありがとうございます。プログラムを動かしてみて、再度ご報告申し上げます。よろしくお願いします。