文字列の組み合わせ数を調べる方法

質問

図のような表の中から、文字列の組み合わせ数を調べる方法をご教示ください。
順序を問う組み合わせと順不同な組み合わせの２通りの数を調べたいです。
またこの場合はＤ列に結合した文字列を入れたほうが処理が簡単になるでしょうか（例：Ｄ１「ＣＡＢ」）。
なおデータ数（行）は増える可能性がありますが、一行の文字数（列)は増えません。
図の場合だと、「ＰＨＷ」の順序を問う組み合わせ数は「３」、順不同な組み合わせは「４」です。

回答No.5

tom04 · ベストアンサー

No.4です。

＞同じ組み合わせの重複を除いて、組み合わせ数の多い順に表記
の件について・・・

並び替えは最優先が「順序を問う」組み合わせ数（D列）
次に優先されるのは「順不問」の組み合わせ数　（E列）
の降順としてみました。

Sub Sample2() 'この行から
Dim i As Long, endRow As Long
endRow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "E"), Cells(endRow, "E"))
.Formula = "=A1&B1&C1"
.Value = .Value
End With
With Range(Cells(1, "D"), Cells(endRow, "D"))
.Formula = "=COUNTIF(E:E,E1)"
.Value = .Value
End With

For i = 1 To endRow
With Cells(1, "G")
.Value = Cells(i, "A")
.Offset(1) = Cells(i, "B")
.Offset(2) = Cells(i, "C")
End With
Range(Cells(1, "G"), Cells(3, "G")).Sort key1:=Cells(i, "G"), order1:=xlAscending, Header:=xlNo
Cells(i, "F") = Cells(1, "G") & Cells(2, "G") & Cells(3, "G")
Next i
With Range(Cells(1, "E"), Cells(endRow, "E"))
.Formula = "=COUNTIF(F:F,F1)"
.Value = .Value
End With
'これ以降を追加
With Range("A1").CurrentRegion
.Sort key1:=Range("D1"), order1:=xlDescending, Header:=xlNo
.Sort key1:=Range("E1"), order1:=xlDescending, Header:=xlNo
End With
For i = endRow To 2 Step -1
If WorksheetFunction.CountIf(Range("F:F"), Cells(i, "F")) > 1 Then
Rows(i).Delete
End If
Next i
'↑まで追加
Range("F:G").Delete
Application.ScreenUpdating = True
End Sub 'この行まで

※　元データの「順序を問う」行の重複行を削除していますので
元データに手を付けてはいけないのであれば別Sheetに表示させる方法になるかと思います。m(_ _)m

回答No.6

emaxemax

No2-3です。

>この式の場合は範囲を指定しないと駄目なのでしょうか？

エクセルのバージョンが2007以上なら、COUNTIFSが使えますので

=COUNTIFS(D:D,"*"&A2&"*",D:D,"*"&B2&"*",D:D,"*"&C2&"*")

と、列指定でもOKです。

回答No.4

tom04

こんばんは！
VBAになってしまいますが、一例です。

D列に「順序を問う」組み合わせ数、E列に「順不問」の組み合わせ数を表示させるとします。
F列以降を作業用の列として使用していますので、F列以降は全く使用していない！という前提です。
データは1行目からとしています。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, endRow As Long
endRow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "E"), Cells(endRow, "E"))
.Formula = "=A1&B1&C1"
.Value = .Value
End With
With Range(Cells(1, "D"), Cells(endRow, "D"))
.Formula = "=COUNTIF(E:E,E1)"
.Value = .Value
End With
Range("E:E").Delete
For i = 1 To endRow
With Cells(1, "G")
.Value = Cells(i, "A")
.Offset(1) = Cells(i, "B")
.Offset(2) = Cells(i, "C")
End With
Range(Cells(1, "G"), Cells(3, "G")).Sort key1:=Cells(i, "G"), order1:=xlAscending, Header:=xlNo
Cells(i, "F") = Cells(1, "G") & Cells(2, "G") & Cells(3, "G")
Next i
With Range(Cells(1, "E"), Cells(endRow, "E"))
.Formula = "=COUNTIF(F:F,F1)"
.Value = .Value
End With
Range("F:G").Delete
Application.ScreenUpdating = True
End Sub 'この行まで

※　関数でないのでデータ変更があるたびにマクロを実行する必要があります。m(_ _)m

補足

ありがとうございます。ＶＢＡなら同じ組み合わせの重複を除いて、組み合わせ数の多い順に表記させることはできますか？

同じ組み合わせの重複を除くとは、

（順序を問う場合）
ＡＢＣ　１
ＡＢＣ　１
↓
ＡＢＣ　１

ということです。

回答No.3

emaxemax

No2です。

順不同の場合の式を訂正します。（＄マークを忘れてました）

=SUMPRODUCT(ISNUMBER(FIND(A1,$D$1:$D$1000))*ISNUMBER(FIND(B1,$D$1:$D$1000))*ISNUMBER(FIND(C1,$D$1:$D$1000)))

補足

この式の場合は範囲を指定しないと駄目なのでしょうか？

回答No.2

emaxemax

D列を作業列として結合した文字列表示にします。
=CONCATENATE(A1,B1,C1)　で結合できますのでフィルドラックして下へコピー。

順序を問う組み合わせ
=COUNTIF(D:D,D1)
この式をフィルドラックして下へコピー。

順不同な組み合わせ
範囲が１から１０００行目までの場合

=SUMPRODUCT(ISNUMBER(FIND(A1,D1:D1000))*ISNUMBER(FIND(B1,D1:D1000))*ISNUMBER(FIND(C1,D1:D1000)))
この式をフィルドラックして下へコピー。

回答No.1

某HN クロメート(Chromate)（@CoalTar）

3列しかないなら、作業列使ったほうが分かりよいと思うので
順序通り
D2セル =A2&B2&C2
下へオートフィル
E2セル =COUNTIF($D$2:$D$21,D2)
フィルハンドルダブルクリック

順不同 大文字小文字は判別しない。同じ文字(A14:C18セルのような)がある場合も考えて
G2セル
=D2
H2セル
=IF(G2=B2&C2&A2,"",B2&C2&A2)
I2セル
=IF(G2=C2&A2&B2,"",C2&A2&B2)
J2セル
=IF(ISNUMBER(MATCH(C2&B2&A2,G2:I2,0)),"",C2&B2&A2)
K2セル
=IF(ISNUMBER(MATCH(B2&A2&C2,G2:I2,0)),"",B2&A2&C2)
L2セル
=IF(ISNUMBER(MATCH(A2&C2&B2,G2:I2,0)),"",A2&C2&B2)
G2:L2セルを選択して下へオートフィル
M2セル
=COUNTIF($G$2:$L$21,D2)
フィルハンドルダブルクリック