🔧
ExtractText
ユーティリティ文字列から英字のみを抽出する
特定のパターンや条件に基づいてセルからテキスト部分を抽出するVBAマクロです。Left・Right・Mid・Instr関数の組み合わせや正規表現を使って、メールアドレス・URLの抽出、括弧内のテキスト取得、特定区切り文字以前の文字列取得などに対応します。構造化されていない自由記述テキストからデータを取り出す前処理として広く活用されます。内部ではInStr関数でデリミタの位置を特定し、Mid関数で目的の部分文字列を切り出す組み合わせが基本形で、より複雑なパターンにはRegExpオブジェクトを併用します。ExtractNumbersが数値特化であるのに対し、本マクロは任意のテキストパターンに対応する汎用性の高い抽出ツールとして位置付けられます。関数を組み合わせた長い数式をセルに書く必要がなく、コードとして再利用しやすい点も利点です。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： 英字を抽出する文字列が含まれるセル範囲を選択して実行
🎯 活用シーン
- ✓「(株) 山田商事」から会社名部分（括弧内）を抽出して整理
- ✓URLリストからドメイン名だけを取り出して集計分析
- ✓住所文字列から都道府県部分を抽出して地域別に集計
- ✓問い合わせメールの本文からお客様番号や注文番号のパターンを抽出し、対応履歴に自動記録したいとき
- ✓SNS投稿データからハッシュタグ部分だけを抽出して、キーワードの出現頻度を分析したいとき
💡 実装のヒント
- ▸InStrでデリミタの位置を取得してMidで部分文字列を抽出できます
- ▸RegExpで複雑なパターン（メールアドレス等）を精度高く抽出できます
- ▸Left(text, InStr(text, "@")-1)でメールのユーザー名部分を取得できます
- ▸抽出パターンが複数存在する列に対しては、まずサンプルデータで正規表現の精度を検証してから全件処理に適用することをお勧めします。
- ▸抽出に失敗した場合（デリミタが見つからない等）のエラー処理を必ず組み込み、空欄や元データのまま残す仕様にしておくと安全です。
💻 VBAコード
' ExtractText
' -----------------
' Macro Name: ExtractText
' Description: 文字列から英字のみを抽出する
' Parameters: なし
' Returns: なし
' Usage: 英字を抽出する文字列が含まれるセル範囲を選択して実行
' -----------------
Sub ExtractText()
Dim cell As Range
Dim resultWs As Worksheet
Dim outputRow As Long
On Error GoTo ErrorHandler
If TypeName(Selection) <> "Range" Then
MsgBox "セル範囲を選択してください。", vbExclamation
Exit Sub
End If
Set resultWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
resultWs.Name = "英字抽出_" & Format(Now, "hhnnss")
resultWs.Cells(1, 1).Value = "英字抽出結果"
resultWs.Cells(1, 1).Font.Bold = True
resultWs.Cells(1, 1).Font.Size = 14
resultWs.Cells(3, 1).Value = "元のセル"
resultWs.Cells(3, 2).Value = "元の値"
resultWs.Cells(3, 3).Value = "抽出結果"
resultWs.Cells(3, 1).Font.Bold = True
resultWs.Cells(3, 2).Font.Bold = True
resultWs.Cells(3, 3).Font.Bold = True
resultWs.Range(resultWs.Cells(3, 1), resultWs.Cells(3, 3)).Interior.Color = RGB(200, 200, 200)
outputRow = 4
For Each cell In Selection
If cell.Value <> "" Then
Dim originalText As String
Dim normalizedText As String
Dim extractedTxt As String
Dim i As Long
originalText = CStr(cell.Value)
normalizedText = StrConv(originalText, vbNarrow)
extractedTxt = ""
For i = 1 To Len(normalizedText)
Dim ch As String
ch = Mid(normalizedText, i, 1)
If (ch >= "a" And ch <= "z") Or (ch >= "A" And ch <= "Z") Then
extractedTxt = extractedTxt & ch
End If
Next i
resultWs.Cells(outputRow, 1).Value = cell.Address
resultWs.Cells(outputRow, 2).Value = originalText
resultWs.Cells(outputRow, 3).Value = extractedTxt
outputRow = outputRow + 1
End If
Next cell
resultWs.Columns("A:C").AutoFit
resultWs.Select
MsgBox "英字抽出が完了しました。", vbInformation
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub