Sub ReplaceWithExtractedData() Dim secondSourceWorksheet As Worksheet Dim lastRow As Long, lastColumn As Long Dim currentCell As Range Dim inputString As String Dim startPos As Integer, endPos As Integer Dim extractedData As String Dim i As Long ' secondSourceWorksheet を設定 Set secondSourceWorksheet = ThisWorkbook.Worksheets("Sheet2") ' シート名を適切に変更してください ' 最終行および最終列を取得 lastRow = secondSourceWorksheet.Cells(Rows.Count, "A").End(xlUp).Row lastColumn = secondSourceWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column ' 最終列から数えて2列目にある各行の文字列を処理 For i = 1 To lastRow Set currentCell = secondSourceWorksheet.Cells(i, lastColumn - 1) inputString = currentCell.Value ' 開始位置と終了位置を検索 startPos = InStr(inputString, "(") + 1 endPos = InStr(inputString, ")") - 1 ' 開始位置と終了位置の間のデータを抽出 If startPos > 1 And endPos >= startPos Then extractedData = Mid(inputString, startPos, endPos - startPos + 1) Else extractedData = "" End If ' 抽出したデータに現在のセルの値を置き換え currentCell.Value = extractedData Next i End Sub