Excel で２つ（または３つ）のキーワードを組み合わせて入力する方法のご紹介です。
キーワードが2、3個なら少ないので何ともないですが、
キーワードが10個や20個となると組み合わせの作業というのはめんどくさいですよね。
できればパパっとできるようにしたい方へ、
Excel さえあればだれでも簡単にできる「キーワード組み合わせ自動化」マクロをご紹介します。
Excel で「キーワード組み合わせ自動化」
今回ご紹介する「キーワード組み合わせ自動化」マクロですが２種類あります。
- １列に記述したキーワードの組み合わせを出力
- ２列に記述したキーワードの組み合わせを出力
１列に記述したキーワードの組み合わせを出力
これは１列にキーワードを記述し（下の左表）、そのキーワードのすべての組み合わせを出力させる（下の右表）ツールです。
作成方法
※作成する前に他の開いている Excel ファイルをすべて閉じてください。
（１）以下の画像のように Excel のレイアウトを変更します。シート名、ファイル名はなんでもいいです。
（２）Excel の「開発」→ 「Visual Basic」をクリックします。「開発」タブがない人はこちらを確認ください。
（３）「Microsoft Excel Object」を右クリックしてください。
（４）「挿入」→ 「標準モジュール」をクリックします。
（５）下記画面が表示されますので赤枠の箇所に次の全てコードをコピーして貼り付けます。
コピーした内容を貼り付ける箇所
コピーするコード （すべてコピーしてください）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 |
' キーワード組み合わせマクロ Sub Keywordcombination() Const readRow As Integer = 1 ' データの列番号 Dim Data() As String: ReDim Data(getMaxRow(readRow) - 1) ' 初期化 Call initialize(readRow) ' データ読み込み Call readData(Data, readRow) ' データ書き込み Call writeData(Data, readRow) ' ファイルに出力 'Call outputFile(readRow) End Sub ' 初期化 Private Sub initialize(readRow As Integer) Range(convertAToNum(readRow + 1) & "2:" & convertAToNum(readRow + 1) & "65536").ClearContents End Sub ' データ読み込み Private Sub readData(ByRef Data() As String, readRow As Integer) Dim index As Integer: index = 0 If getMaxRow(readRow) = 1 Then MsgBox "データを入力してください" End End If For i = 1 To getMaxRow(readRow) Data(index) = Cells(i, readRow).Value index = index + 1 Next i End Sub ' データ書き込み Private Sub writeData(ByRef Data() As String, readRow As Integer) Dim line As Integer: line = 1 For i = 1 To UBound(Data) For j = i + 1 To UBound(Data) If Data(i) <> Data(j) Or Data(i) <> "" Or Data(j) <> "" Then line = line + 1 Cells(line, readRow + 1).Value = Data(i) & " " & Data(j) End If Next j Next i End Sub ' データ書き込み Private Sub outputFile(readRow As Integer) Dim outputword As String: outputword = "" Dim fname As String: fname = printDialog() If fname <> "" Then For i = 2 To getMaxRow(readRow + 1) If i = 2 Then outputword = Cells(i, readRow + 1).Value Else outputword = outputword & "," & Cells(i, readRow + 1).Value End If Next i Open fname For Output As #1 Print #1, outputword MsgBox "ファイルに出力されました。" Close #1 End If End Sub ' ファイル選択用ダイヤログ表示 Function printDialog() Dim fname As Variant fname = Application.GetSaveAsFilename( _ InitialFileName:="test.txt", _ filefilter:="テキストファイル,*.txt", _ Title:="ファイル保存") If VarType(fname) = vbBoolean Then MsgBox "キャンセルされました。" printDialog = "" Else printDialog = fname End If End Function ' 最終行番号 Function getMaxRow(row As Integer) As Integer getMaxRow = Range(convertAToNum(row) & "65536").End(xlUp).row End Function ' 列番号変換 アルファベット → 数値 Function convertAToNum(ByVal num As Long) As String tmp = Cells(1, num).Address(True, False) convertAToNum = Left(tmp, InStr(tmp, "$") - 1) End Function |
（６）画面を閉じてさっきの Excel 画面に戻ります。①キーワードを A 列に入力し ②「開発」→「マクロ」とクリックします。
※ キーワードは必ず A 列２行目から入力してください。１行目にキーワードを入れても組み合わせには出力されません。
（７）「KeyWordcombination」を選択し、「実行」をクリックします。
（８）B列目にキーワードの組み合わせが表示されます。
簡単ですね！以上になります。
２列に記述したキーワードの組み合わせを出力
２列のキーワードの組み合わせを自動で行う方法を紹介します。
作成方法
（１）新しく Excel を開いてください。そして下記画面のようにレイアウトを作成してください。シート名、ファイル名はなんでもいいです。
（２）このページの「１列に記述したキーワードの組み合わせを出力」で解説しました手順（２）～（５）と同様に行います。そして下記画面に以下のコードをすべてコピーして張り付けます。
コピーした内容を貼り付ける箇所
コピーするコード （すべてコピーしてください）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 |
' キーワード組み合わせマクロ Sub MultiKeywordcombination() Dim Data1() As String: ReDim Data1(getMaxRow(1) - 2) Dim Data2() As String: ReDim Data2(getMaxRow(2) - 2) Dim afterData() As String: ReDim afterData(sumData()) ' 初期化 Call initialize ' データ読み込み Call readData(Data1, Data2) ' データ書き込み Call writeData(Data1, Data2, afterData) ' ファイルに出力 'Call outputFile(afterData) End Sub ' 初期化 Private Sub initialize() Range("C2:C65536").ClearContents End Sub ' データ読み込み Private Sub readData(ByRef Data1() As String, ByRef Data2() As String) ' A 列目 Call inputVal(Data1, 1) ' B 列目 Call inputVal(Data2, 2) End Sub ' データ書き込み Private Sub writeData(ByRef Data1() As String, ByRef Data2() As String, ByRef afterData() As String) Dim i As Integer Dim j As Integer Dim index As Integer: index = 0 For i = 0 To UBound(Data1) For j = 0 To UBound(Data2) If Len(Data1(i)) <> 0 And Len(Data2(j)) <> 0 Then afterData(index) = Data1(i) & " " & Data2(j) Cells(index + 2, 3).Value = afterData(index) index = index + 1 End If Next j Next i End Sub ' ファイルに出力 Private Sub outputFile(ByRef afterData() As String) Dim outputword As String Dim fname As String: fname = printDialog() If fname <> "" Then Open fname For Output As #1 For i = 0 To UBound(afterData) - 1 If i = 0 Then outputword = afterData(i) ElseIf i = UBound(afterData) - 1 Then outputword = outputword & "," & afterData(i) Else outputword = outputword & "," & afterData(i) & "," End If Next i Print #1, outputword MsgBox "ファイルに出力されました。" Close #1 End If End Sub ' ファイル選択用ダイヤログ表示 Function printDialog() Dim fname As Variant fname = Application.GetSaveAsFilename( _ InitialFileName:="test.txt", _ filefilter:="テキストファイル,*.txt", _ Title:="ファイル保存") If VarType(fname) = vbBoolean Then MsgBox "キャンセルされました。" printDialog = "" Else printDialog = fname End If End Function ' 変数に値を格納 Private Sub inputVal(ByRef Data() As String, ByVal col As Integer) Dim i As Integer Dim index As Integer: index = 0 ' A 列目 For i = 2 To getMaxRow(col) Data(index) = Cells(i, col).Value index = index + 1 Next i index = 0 End Sub ' 合計データ数 Function sumData() As Integer Dim i As Integer Dim sum As Integer: sum = 1 For i = 1 To getMaxCol() sum = sum * getMaxRow(i) Next i sumData = sum End Function ' 最終行番号 Function getMaxRow(row As Integer) As Integer getMaxRow = Range(convertAToNum(row) & "65536").End(xlUp).row End Function ' 最終列番号 Function getMaxCol() As Integer getMaxCol = Range("IV1").End(xlToLeft).Column End Function ' 列番号変換 アルファベット → 数値 Function convertAToNum(ByVal num As Long) As String tmp = Cells(1, num).Address(True, False) convertAToNum = Left(tmp, InStr(tmp, "$") - 1) End Function |
（３）画面を閉じてさっきの Excel 画面に戻ります。①キーワードを A 列とB 列に入力し ②「開発」→「マクロ」とクリックします。
※ キーワードは必ず A 列とB 列の２行目から入力してください。１行目にキーワードを入れても組み合わせには出力されません。
（４）「MultiKeyWordcombination」を選択し、「実行」をクリックします。
（５）C 列に A 列 と B 列 のキーワードが出力されます。
以上です。これもすぐにできると思います。
最後に
最後までご精読ありがとうございました。
なお今回コピーして貼り付けたコードにはファイル出力機能もあります。
もしファイル出力機能をつけたいのなら貼り付けるコードの以下の箇所の先頭にある「’」（シングルクォーテーション）を外して貼り付けてください。
（変更前）'Call outputFile(afterData)
（変更後）Call outputFile(afterData)
