承知いたしました。Excelの作業をマクロで自動化したいのですね！B列のセル内で改行されている情報を元に、特定の文字を抽出して新しいC列に反映させる、というご要望ですね。一緒に考えていきましょう！😊

まず、いただいた例を元に、B列のセルから「名前」「顧客」「監督」の情報を抽出し、C列に表示させるためのVBAコードを作成してみましょう。

VBAコードの例

Sub ExtractInfoToColumnC()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim bColumnValue As String
    Dim cColumnValue As String
    Dim lines() As String
    Dim name As String
    Dim customer As String
    Dim supervisor As String

    ' 作業対象のシートを設定します
    Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" は実際のシート名に変更してください

    ' B列の最終行を取得します
    lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row

    ' C列にヘッダーを追加します（必要であれば）
    ws.Cells(1, "C").Value = "抽出情報" ' ヘッダー名も必要に応じて変更してください

    ' B列の各セルをループ処理します
    For i = 2 To lastRow ' 2行目から開始（ヘッダー行を除く場合）
        bColumnValue = ws.Cells(i, "B").Value

        ' セル内の改行で分割して配列に格納します
        lines = Split(bColumnValue, vbLf) ' vbLf は改行コードです

        ' 各行をチェックして情報を抽出します
        name = ""
        customer = ""
        supervisor = ""

        For Each line In lines
            ' 名前を抽出（"名前："で始まる行）
            If InStr(line, "名前：") > 0 Then
                name = Trim(Replace(line, "名前：", ""))
            End If

            ' 顧客を抽出（"顧客："で始まる行）
            If InStr(line, "顧客：") > 0 Then
                customer = Trim(Replace(line, "顧客：", ""))
            End If

            ' 監督を抽出（"監督："で始まる行）
            If InStr(line, "監督：") > 0 Then
                supervisor = Trim(Replace(line, "監督：", ""))
            End If
        Next line

        ' 抽出した情報を結合してC列に反映します
        cColumnValue = ""
        If name <> "" Then
            cColumnValue = cColumnValue & "名前：" & name & vbLf
        End If
        If customer <> "" Then
            cColumnValue = cColumnValue & "顧客：" & customer & vbLf
        End If
        If supervisor <> "" Then
            cColumnValue = cColumnValue & "監督：" & supervisor & vbLf
        End If

        ' 末尾の改行コードを削除します（もしあれば）
        If Right(cColumnValue, 1) = vbLf Then
            cColumnValue = Left(cColumnValue, Len(cColumnValue) - 1)
        End If

        ' C列に結果を書き込みます
        ws.Cells(i, "C").Value = cColumnValue

    Next i

    MsgBox "抽出作業が完了しました！", vbInformation

End Sub

このコードのポイント

1. Dim宣言: 変数を宣言して、メモリを確保します。
2. Set ws = ThisWorkbook.Sheets("Sheet1"): マクロを実行するExcelブック内の、どのシートを対象にするかを指定します。"Sheet1"の部分は、実際のシート名に合わせて変更してくださいね。
3. lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row: B列のデータが入っている最後の行番号を取得します。これにより、データ量が変わっても自動的に対応できます。
4. Split(bColumnValue, vbLf): B列のセルに入っている文字列を、改行コード（vbLf）で区切って、配列linesに格納します。これで、各行の情報を個別に扱うことができます。
5. InStr(line, "名前：") > 0: 各行に「名前：」という文字列が含まれているかを確認します。
6. Trim(Replace(line, "名前：", "")): もし「名前：」が含まれていたら、その部分を取り除き、前後の余分なスペースを削除して、名前の部分だけを抽出します。
7. cColumnValue = cColumnValue & "名前：" & name & vbLf: 抽出した情報を、新しいC列用の文字列として組み立てていきます。改行を挟んで、見やすくしています。
8. ws.Cells(i, "C").Value = cColumnValue: 組み立てた文字列を、対応する行のC列に書き込みます。
9. MsgBox "抽出作業が完了しました！": 処理が終わったことを知らせるメッセージを表示します。

マクロの実行方法

1. Excelを開き、Alt + F11 キーを押してVBAエディターを開きます。
2. メニューバーの「挿入」から「標準モジュール」を選択します。
3. 表示されたコードウィンドウに、上記のVBAコードをコピー＆ペーストします。
4. Excelシートに戻り、Alt + F8 キーを押してマクロダイアログボックスを表示します。
5. 作成したマクロ名（ExtractInfoToColumnC）を選択し、「実行」ボタンをクリックします。

もし、抽出したい情報がもっと増えたり、条件が変わったりする場合でも、このコードをベースに調整できますよ！

例えば、

• 「住所」も抽出したい場合 → If InStr(line, "住所：") > 0 Then ... のような行を追加します。
• 抽出する順番を変えたい場合 → cColumnValue を組み立てる部分の順番を入れ替えます。

どうでしょうか？もし、このコードでうまくいかない点や、さらに「こんなこともしたい！」というご要望があれば、遠慮なく教えてくださいね！一緒に、もっと便利で快適なExcel作業を目指しましょう！✨

C列に新しい列が挿入されず、既存のC列の内容が上書きされてしまっているとのことですね。ご指摘ありがとうございます！🙇‍♀️

以前お伝えしたVBAコードでは、新しい列を挿入するのではなく、既存のC列に抽出した情報を書き込むようになっています。もし、C列を新しく追加したい場合は、コードの修正が必要です。

新しいC列を挿入してから情報を書き込む方法

既存のC列に上書きされるのを防ぎ、新しい列としてC列を追加するには、以下の手順でコードを修正するのが一般的です。

1. 列を挿入する処理を追加する: マクロの実行前に、C列の前に新しい列を挿入します。
2. 抽出情報を新しい列に書き込む: 修正したコードで、新しい列（この場合、元のC列がD列に移動するので、新しいC列になります）に情報を書き込みます。

例えば、以下のようにコードの冒頭部分を変更することで、C列の前に新しい列を挿入してから処理を実行できます。

Sub ExtractInfoToColumnC_InsertColumn()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim bColumnValue As String
    Dim cColumnValue As String
    Dim lines() As String
    Dim name As String
    Dim customer As String
    Dim supervisor As String

    ' 作業対象のシートを設定します
    Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" は実際のシート名に変更してください

    ' ★★★ C列の前に新しい列を挿入します ★★★
    ws.Columns("C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    ' C列にヘッダーを追加します（必要であれば）
    ws.Cells(1, "C").Value = "抽出情報" ' ヘッダー名も必要に応じて変更してください

    ' B列の最終行を取得します
    lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row

    ' B列の各セルをループ処理します
    For i = 2 To lastRow ' 2行目から開始（ヘッダー行を除く場合）
        bColumnValue = ws.Cells(i, "B").Value

        ' セル内の改行で分割して配列に格納します
        lines = Split(bColumnValue, vbLf) ' vbLf は改行コードです

        ' 各行をチェックして情報を抽出します
        name = ""
        customer = ""
        supervisor = ""

        For Each line In lines
            ' 名前を抽出（"名前："で始まる行）
            If InStr(line, "名前：") > 0 Then
                name = Trim(Replace(line, "名前：", ""))
            End If

            ' 顧客を抽出（"顧客："で始まる行）
            If InStr(line, "顧客：") > 0 Then
                customer = Trim(Replace(line, "顧客：", ""))
            End If

            ' 監督を抽出（"監督："で始まる行）
            If InStr(line, "監督：") > 0 Then
                supervisor = Trim(Replace(line, "監督：", ""))
            End If
        Next line

        ' 抽出した情報を結合してC列に反映します
        cColumnValue = ""
        If name <> "" Then
            cColumnValue = cColumnValue & "名前：" & name & vbLf
        End If
        If customer <> "" Then
            cColumnValue = cColumnValue & "顧客：" & customer & vbLf
        End If
        If supervisor <> "" Then
            cColumnValue = cColumnValue & "監督：" & supervisor & vbLf
        End If

        ' 末尾の改行コードを削除します（もしあれば）
        If Right(cColumnValue, 1) = vbLf Then
            cColumnValue = Left(cColumnValue, Len(cColumnValue) - 1)
        End If

        ' C列に結果を書き込みます
        ws.Cells(i, "C").Value = cColumnValue

    Next i

    MsgBox "抽出作業が完了しました！新しいC列に情報が反映されています。", vbInformation

End Sub

この修正では、ws.Columns("C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove という行が追加されています。これにより、マクロが実行されるたびにC列の前に新しい列が挿入され、その新しいC列に抽出結果が書き込まれるようになります。

もし、この修正で意図した通りにならない場合や、他に試したいことがあれば、遠慮なくおっしゃってくださいね！😊

• もしかして、既存のC列を削除してから新しいC列にしたい、というご要望でしょうか？
• あるいは、C列ではなく、D列などに新しい列を追加したい、というご希望はありますか？