- MeCabのパッケージ(バイナリ一式)の入手
https://taku910.github.io/mecab/
Binary package for MS-Windows
https://github.com/ikegami-yukino/mecab/releases
mecab-64-0.996.2.exe
https://app.box.com/s/bhohue5wh90xj8lxae0c8v72zlwwxswt
2.辞書のコンパイルファイル
https://app.box.com/s/17ziot4k59zw2ct8f4ego1z61i7xdv48
MeCabのフォルダ構成が以下のようになっていると想定します。
C:\mecab\bin\mecab.exe
C:\mecab\dic\ipadic (システム辞書)
C:\mecab\dic\user_kanji.dic (持ち込んだ辞書)
C:\mecab\dic\user_roma.dic (持ち込んだ辞書)
C:\mecab\etc\mecabrc (設定ファイル)
この場合、C:\mecab\etc\mecabrc をメモ帳で開き、最後の行を以下のように設定してください。
dicdir = C:\mecab\dic\ipadic
userdic = C:\mecab\dic\user_kanji.dic,C:\mecab\dic\user_roma.dic
Sub CheckNamesBatch_TwoColumns()
Dim ws As Worksheet
Dim lastRow As Long
Dim dataArr1 As Variant, dataArr2 As Variant
Dim combinedArr() As String
Dim resultArr() As Variant
Dim i As Long
' --- 設定項目 ---
Dim mecabPath As String
Dim userDicPath As String
Dim inputCol1 As String
Dim inputCol2 As String
Dim outputCol As String
' MeCab本体とカスタム辞書のパスを指定
mecabPath = "C:\mecab\bin\mecab.exe"
userDicPath = "C:\mecab\dic\user_roma.dic" ' ビルドしたカスタム辞書
' 対象シートと列の指定
Set ws = ThisWorkbook.Sheets("Sheet1")
inputCol1 = "A" ' 検査したい1つ目の列
inputCol2 = "B" ' 検査したい2つ目の列
outputCol = "C" ' 結果(True/False)を出力する列
' ----------------
' 最大の最終行を取得(A列とB列でデータ行数が違うケースを考慮)
Dim lastRow1 As Long, lastRow2 As Long
lastRow1 = ws.Cells(ws.Rows.Count, inputCol1).End(xlUp).Row
lastRow2 = ws.Cells(ws.Rows.Count, inputCol2).End(xlUp).Row
lastRow = IIf(lastRow1 > lastRow2, lastRow1, lastRow2)
If lastRow < 2 Then Exit Sub ' データがない場合は終了
' 高速化のためデータを一気に配列へ格納
dataArr1 = ws.Range(inputCol1 & "2:" & inputCol1 & lastRow).Value
dataArr2 = ws.Range(inputCol2 & "2:" & inputCol2 & lastRow).Value
ReDim combinedArr(1 To UBound(dataArr1, 1))
ReDim resultArr(1 To UBound(dataArr1, 1), 1 To 1)
' --- 1. 一時ファイルのパスを作成 ---
Dim tempIn As String, tempOut As String
tempIn = Environ("TEMP") & "\mecab_input.txt"
tempOut = Environ("TEMP") & "\mecab_output.txt"
' --- 2. 2列のデータを結合して一時ファイルに書き出し ---
Dim fso As Object, ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(tempIn, True, False)
Dim val1 As String, val2 As String
Dim combinedText As String
For i = 1 To UBound(dataArr1, 1)
val1 = "": val2 = ""
' エラー値(#N/Aなど)を回避しつつ文字列を取得
If Not IsError(dataArr1(i, 1)) Then
If Not IsEmpty(dataArr1(i, 1)) Then val1 = CStr(dataArr1(i, 1))
End If
If Not IsError(dataArr2(i, 1)) Then
If Not IsEmpty(dataArr2(i, 1)) Then val2 = CStr(dataArr2(i, 1))
End If
' 2つの列の値を半角スペースで結合する
combinedText = Trim(val1 & " " & val2)
' 改行コードが含まれているとMeCabが誤動作するため除去
combinedText = Replace(Replace(combinedText, vbCr, ""), vbLf, "")
' 後で正規表現判定に使うために配列に保存しておく
combinedArr(i) = combinedText
If combinedText = "" Then
ts.WriteLine " "
Else
ts.WriteLine combinedText
End If
Next i
ts.Close
' --- 3. MeCabを一括実行 ---
Dim shell As Object, cmd As String
Set shell = CreateObject("WScript.Shell")
cmd = "cmd /c """"" & mecabPath & """ -u """ & userDicPath & """ """ & tempIn & """ > """ & tempOut & """"""
shell.Run cmd, 0, True
' --- 4. 出力結果を読み込み、判定を行う ---
Dim outputLine As String
Dim rowIndex As Long
Dim hasName As Boolean
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "^[A-Za-z\s\-\.]+$"
rowIndex = 1
hasName = False
Set ts = fso.OpenTextFile(tempOut, 1, False, False)
Do While Not ts.AtEndOfStream
outputLine = ts.ReadLine
If outputLine = "EOS" Then
' MeCabで人名が見つからなかった場合のみ、結合した文字列でローマ字判定
If Not hasName Then
If regEx.Test(combinedArr(rowIndex)) And InStr(combinedArr(rowIndex), " ") > 0 Then
hasName = True
End If
End If
resultArr(rowIndex, 1) = hasName
rowIndex = rowIndex + 1
hasName = False
If rowIndex > UBound(dataArr1, 1) Then Exit Do
Else
If InStr(outputLine, "人名") > 0 Or InStr(outputLine, "固有名詞") > 0 Then
hasName = True
End If
End If
Loop
ts.Close
' --- 5. 判定結果をExcelに一括書き出し ---
ws.Range(outputCol & "2").Resize(UBound(resultArr, 1), 1).Value = resultArr
' 一時ファイルの削除
If fso.FileExists(tempIn) Then fso.DeleteFile tempIn
If fso.FileExists(tempOut) Then fso.DeleteFile tempOut
Set ts = Nothing
Set fso = Nothing
Set shell = Nothing
Set regEx = Nothing
MsgBox "2列の結合チェックが完了しました!", vbInformation
End Sub
Excelで Alt + F11 を押してVBAエディタを開きます。
挿入 > 標準モジュール をクリックし、以下のコードを貼り付けてください。
コード上部の mecabPath と userDicPath を、ご自身の環境に合わせて書き換えてください。
- 最終設定の再確認
社内PCの環境が以下のようになっているか、最後にもう一度だけ確認してください。
辞書ファイルの配置: C:\mecab\dic\ の中に user_kanji.dic と user_roma.dic がある。
設定ファイル: C:\mecab\etc\mecabrc を開き、末尾が以下のようになっている。
dicdir = C:\mecab\dic\ipadic
userdic = C:\mecab\dic\user_kanji.dic,C:\mecab\dic\user_roma.dic
- VBAコードの微調整
もしVBAコード内の「ユーザー辞書のパス」が旧名のままだったり、今回作成したパスと異なっていたりするとエラーになります。VBAコードの以下の部分を、今の環境に合わせて正確に書き換えてください。
VBA
' VBAコード内の設定項目を修正
mecabPath = "C:\mecab\bin\mecab.exe"
userDicPath = "C:\mecab\dic\user_kanji.dic,C:\mecab\dic\user_roma.dic"
※このようにカンマ区切りで両方のパスを指定すれば、VBAは自動的に両方の辞書を読み込んで解析してくれます。
- いざ実行!
準備ができたら、Excelで Alt + F8 を押し、作成した CheckNamesBatch_TwoColumns を選択して「実行」ボタンを押してください。
もし「うまくいかない(エラーが出る)」場合の切り分け方
万が一、VBAを実行してエラーが出た場合は、どこで止まっているかで原因がすぐ特定できます。
「ファイルが見つかりません」と出る場合: mecabPath または userDicPath に書かれたパスのどこかが、実際のフォルダ構成と1文字でも違っています。エクスプローラーのパスと見比べてみてください。
何も結果が出ない、またはすべてFalseになる場合: 辞書の設定(mecabrc)がうまく読み込まれていません。コマンドプロンプトを立ち上げ、以下を直接入力して動作するか確認してください。
DOS
"C:\mecab\bin\mecab.exe" -u "C:\mecab\dic\user_kanji.dic,C:\mecab\dic\user_roma.dic"
これで「山田太郎」と打って「人名」と返ってくれば、MeCab自体は完璧です。その場合はVBA側の記述ミスですので、パスを確認しましょう。
これですべての手順が完了です!