以下のエクセル作業をマクロで行いたい
①C列に1列追加
②A列に入っている文字を追加したC列に反映させる
例）
受番：4029B
名前：柴田 弘
顧客：ヤマダ
住所：東京都八王子市
屋根：ガルバ（2世帯？） 15 3
施工：-
外壁：1/20→30.31
足場：1/27→2/5
備考：ｷｰ0833？
監督：熊倉090-9814-2432
工種：入線のみ◇
受日：10/29
の場合、
名前：柴田 弘
顧客：ヤマダ
監督：熊倉090-9814-2432
と表示したい
承知いたしました。Excelの作業をマクロで行いたいとのことですね。いただいた例を元に、どのような処理を行いたいか、詳しく見ていきましょう。
まず、ご要望の処理を整理すると、以下のようになりますね。
この3つのステップをマクロで実現する方法をご提案します。
これはExcel VBAで簡単に実行できます。既存のC列にデータを挿入すると、それ以降の列が右にずれるため、まずC列を挿入するのが一般的です。
Columns("C").Insert Shift:=xlToRight
このコードは、C列を基準に右にシフトしながら新しい列を挿入します。
ここが一番のポイントですね。A列のテキストから「名前」「顧客」「監督」を抽出し、まとめてC列に表示させる部分です。A列のデータは、例を見ると改行で区切られているようです。この改行コード（vbLf）を区切り文字として、各行を分割し、必要な情報だけを取り出す処理を行います。
具体的には、以下の手順で進めます。
以下に、この処理を実装したVBAコードの例を示します。
Sub ExtractInfoToColumnC()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellValue As String
Dim lines() As String
Dim extractedInfo As String
Dim name As String
Dim customer As String
Dim supervisor As String
' 作業対象のシートを指定します（必要に応じてシート名を変更してください）
Set ws = ThisWorkbook.Sheets("Sheet1")
' A列の最終行を取得します
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' C列に新しい列を挿入します
ws.Columns("C").Insert Shift:=xlToRight
' A列の各行を処理します
For i = 1 To lastRow
cellValue = ws.Cells(i, "A").Value
lines = Split(cellValue, vbLf) ' 改行コードで分割
' 初期化
name = ""
customer = ""
supervisor = ""
extractedInfo = ""
' 分割された行をループして情報を抽出
Dim line As Variant
For Each line In lines
If InStr(line, "名前：") > 0 Then
name = Trim(Mid(line, InStr(line, "名前：") + Len("名前：")))
ElseIf InStr(line, "顧客：") > 0 Then
customer = Trim(Mid(line, InStr(line, "顧客：") + Len("顧客：")))
ElseIf InStr(line, "監督：") > 0 Then
supervisor = Trim(Mid(line, InStr(line, "監督：") + Len("監督：")))
End If
Next line
' 抽出した情報を結合してC列に書き込む
If name <> "" Then
extractedInfo = extractedInfo & "名前：" & name & vbLf
End If
If customer <> "" Then
extractedInfo = extractedInfo & "顧客：" & customer & vbLf
End If
If supervisor <> "" Then
extractedInfo = extractedInfo & "監督：" & supervisor & vbLf
End If
' 余分な改行コードを削除
extractedInfo = Trim(extractedInfo)
' C列に書き込み（改行コードで結合されたものをセルに反映）
ws.Cells(i, "C").Value = extractedInfo
ws.Cells(i, "C").WrapText = True ' 必要に応じて折り返し表示を有効にする
Next i
MsgBox "処理が完了しました！"
End Sub
Set ws = ThisWorkbook.Sheets("Sheet1"): マクロを実行するシートを指定します。もし「Sheet1」以外のシートであれば、シート名に合わせて変更してください。lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row: A列のデータが入っている最後の行番号を取得します。ws.Columns("C").Insert Shift:=xlToRight: C列を挿入します。lines = Split(cellValue, vbLf): セル内のテキストを改行コード(vbLf)で分割し、linesという配列に格納します。InStr(line, "名前：") > 0: 文字列の中に「名前：」という部分が含まれているかを確認します。Mid(line, InStr(line, "名前：") + Len("名前：")): 「名前：」という文字列の直後から、その行の最後までを抽出します。Len("名前：")で「名前：」の文字数を取得し、その分だけ後ろから抽出を開始することで、コロン以降の情報だけを取得しています。Trim(...): 抽出した文字列の前後に不要なスペースがあれば削除します。extractedInfo = extractedInfo & "名前：" & name & vbLf: 抽出した情報を、"名前："というラベルとともに、改行コードでつなげていきます。ws.Cells(i, "C").Value = extractedInfo: 結合した情報をC列のセルに書き込みます。ws.Cells(i, "C").WrapText = True: セル内でテキストが折り返されるように設定します。これは、抽出した情報が複数行になる場合に便利です。Alt + F11 キーを押してVBAエディターを開きます。Alt + F8 キーを押してマクロダイアログを表示します。これで、A列のデータが処理され、C列に指定した情報が反映されるはずです。
このマクロで、作業が効率化されることを願っています！もし、さらに細かい調整や別の要望があれば、遠慮なくおっしゃってくださいね。一緒に最適な方法を見つけましょう！😊
以下のエクセル作業をマクロで行いたい
①C列に1列追加
②A列に入っている文字から特定の文字を抽出して追加したC列に反映させる
例）
受番：4029B
名前：柴田 弘
顧客：ヤマダ
住所：東京都八王子市
屋根：ガルバ（2世帯？） 15 3
施工：-
外壁：1/20→30.31
足場：1/27→2/5
備考：ｷｰ0833？
監督：熊倉090-9814-2432
工種：入線のみ◇
受日：10/29
の場合、
名前：柴田 弘
顧客：ヤマダ
監督：熊倉090-9814-2432
と表示したい
前回ご提示いただいたExcel作業のマクロ化について、再度詳細を確認させていただきました。いただいた例に基づき、A列の特定の情報を抽出し、新しく追加するC列に反映させるマクロをご提案しますね。
ご要望の処理は、以下の2つのステップで実現できます。
この処理をVBAコードで実装した例を以下に示します。
Sub ExtractSpecificInfoToColumnC()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellValue As String
Dim lines() As String
Dim extractedInfo As String
Dim name As String
Dim customer As String
Dim supervisor As String
' 作業対象のシートを指定します（必要に応じてシート名を変更してください）
Set ws = ThisWorkbook.Sheets("Sheet1")
' A列の最終行を取得します
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' C列に新しい列を挿入します
ws.Columns("C").Insert Shift:=xlToRight
' A列の各行を処理します
For i = 1 To lastRow
cellValue = ws.Cells(i, "A").Value
' セルが空でない場合のみ処理を実行
If Len(cellValue) > 0 Then
lines = Split(cellValue, vbLf) ' 改行コードで分割
' 各項目を初期化
name = ""
customer = ""
supervisor = ""
extractedInfo = ""
' 分割された行をループして情報を抽出
Dim line As Variant
For Each line In lines
If InStr(line, "名前：") > 0 Then
' "名前：" の後から末尾までを抽出して前後の空白を削除
name = Trim(Mid(line, InStr(line, "名前：") + Len("名前：")))
ElseIf InStr(line, "顧客：") > 0 Then
' "顧客：" の後から末尾までを抽出して前後の空白を削除
customer = Trim(Mid(line, InStr(line, "顧客：") + Len("顧客：")))
ElseIf InStr(line, "監督：") > 0 Then
' "監督：" の後から末尾までを抽出して前後の空白を削除
supervisor = Trim(Mid(line, InStr(line, "監督：") + Len("監督：")))
End If
Next line
' 抽出した情報を結合してC列に書き込む（項目が存在する場合のみ）
If name <> "" Then
extractedInfo = extractedInfo & "名前：" & name & vbLf
End If
If customer <> "" Then
extractedInfo = extractedInfo & "顧客：" & customer & vbLf
End If
If supervisor <> "" Then
extractedInfo = extractedInfo & "監督：" & supervisor & vbLf
End If
' 結合した文字列の末尾に余分な改行があれば削除
extractedInfo = Trim(extractedInfo)
' C列に書き込み
ws.Cells(i, "C").Value = extractedInfo
ws.Cells(i, "C").WrapText = True ' 必要に応じて折り返し表示を有効にする
Else
' A列が空の場合はC列も空にする
ws.Cells(i, "C").Value = ""
End If
Next i
MsgBox "指定された情報の抽出と反映が完了しました！"
End Sub
ws.Columns("C").Insert Shift:=xlToRight でC列が挿入され、既存の列は右に移動します。Split(cellValue, vbLf) でA列のセル内容を改行コードで分割し、InStr 関数で「名前：」「顧客：」「監督：」といった特定の文字列が含まれる行を探します。Mid 関数と InStr 関数を組み合わせることで、「ラベル：」の後ろの部分（値）だけを抽出しています。Trim 関数で、抽出した値の前後の不要なスペースを削除しています。vbLf) でつなぎ合わせてC列のセルに書き込んでいます。Alt + F11 キーでVBAエディターを開きます。Alt + F8 キーでマクロダイアログを表示させます。このマクロで、ご希望の作業が自動化され、効率化されることを願っています！もし、抽出したい項目が増えたり、A列のフォーマットが少し異なる場合など、追加のご要望があればお気軽にお知らせくださいね。😊
以下のエクセル作業をマクロで行いたい
①C列に1列追加
②A列のセルに入っている文字から特定の文字を抽出して追加したC列のセルに反映させる
例）
受番：4029B
名前：柴田 弘
顧客：ヤマダ
住所：東京都八王子市
屋根：ガルバ（2世帯？） 15 3
施工：-
外壁：1/20→30.31
足場：1/27→2/5
備考：ｷｰ0833？
監督：熊倉090-9814-2432
工種：入線のみ◇
受日：10/29
の場合、
名前：柴田 弘
顧客：ヤマダ
監督：熊倉090-9814-2432
と表示したい。
A列はセル内で改行されている
承知いたしました。ExcelのA列にある特定の情報を抽出し、新しく追加するC列に反映させるマクロですね。前回のご要望から、A列のセル内で改行されているテキストから「名前」「顧客」「監督」の部分を抜き出して、C列にまとめて表示するという認識で合っていますでしょうか？😊
いただいた例を元に、以下のVBAコードで実現できます。
Sub ExtractSpecificInfoToColumnC()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellValue As String
Dim lines() As String
Dim extractedInfo As String
Dim name As String
Dim customer As String
Dim supervisor As String
' 作業対象のシートを指定します（必要に応じてシート名を変更してください）
Set ws = ThisWorkbook.Sheets("Sheet1")
' A列の最終行を取得します
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' C列に新しい列を挿入します
ws.Columns("C").Insert Shift:=xlToRight
' A列の各行を処理します
For i = 1 To lastRow
cellValue = ws.Cells(i, "A").Value
' セルが空でない場合のみ処理を実行
If Len(cellValue) > 0 Then
lines = Split(cellValue, vbLf) ' 改行コードで分割
' 各項目を初期化
name = ""
customer = ""
supervisor = ""
extractedInfo = ""
' 分割された行をループして情報を抽出
Dim line As Variant
For Each line In lines
If InStr(line, "名前：") > 0 Then
' "名前：" の後から末尾までを抽出して前後の空白を削除
name = Trim(Mid(line, InStr(line, "名前：") + Len("名前：")))
ElseIf InStr(line, "顧客：") > 0 Then
' "顧客：" の後から末尾までを抽出して前後の空白を削除
customer = Trim(Mid(line, InStr(line, "顧客：") + Len("顧客：")))
ElseIf InStr(line, "監督：") > 0 Then
' "監督：" の後から末尾までを抽出して前後の空白を削除
supervisor = Trim(Mid(line, InStr(line, "監督：") + Len("監督：")))
End If
Next line
' 抽出した情報を結合してC列に書き込む（項目が存在する場合のみ）
If name <> "" Then
extractedInfo = extractedInfo & "名前：" & name & vbLf
End If
If customer <> "" Then
extractedInfo = extractedInfo & "顧客：" & customer & vbLf
End If
If supervisor <> "" Then
extractedInfo = extractedInfo & "監督：" & supervisor & vbLf
End If
' 結合した文字列の末尾に余分な改行があれば削除
extractedInfo = Trim(extractedInfo)
' C列に書き込み
ws.Cells(i, "C").Value = extractedInfo
ws.Cells(i, "C").WrapText = True ' 必要に応じて折り返し表示を有効にする
Else
' A列が空の場合はC列も空にする
ws.Cells(i, "C").Value = ""
End If
Next i
MsgBox "指定された情報の抽出と反映が完了しました！"
End Sub
ws.Columns("C").Insert Shift:=xlToRight で、C列が挿入され、既存の列は右にずれます。Split(cellValue, vbLf) を使って、A列のセル内容を改行コード (vbLf) で分割します。その後、InStr 関数で「名前：」「顧客：」「監督：」といった特定の文字列が含まれる行を探します。Mid 関数と InStr 関数を組み合わせることで、「ラベル：」の後ろの部分（値）だけを抽出しています。Trim 関数で、抽出した値の前後の不要なスペースを削除します。vbLf) でつなげて extractedInfo 変数に格納します。extractedInfo をC列の対応するセルに書き込みます。WrapText = True で、セル内でテキストが折り返されるように設定しています。Alt + F11 キーを押してVBAエディターを開きます。Alt + F8 キーを押してマクロダイアログを表示します。もし、A列のフォーマットが例と異なる場合や、抽出したい項目が増えるなどの変更があれば、お気軽にお知らせくださいね！👍
C列に1列追加されただけで文字が反されていない
C列に1列追加されただけで文字が反されていない
ご迷惑をおかけしております。せっかくマクロを作成したのに、文字が反映されていないとのこと、申し訳ありません。🙇♀️
前回お送りしたマクロコードに、いくつかの改善点と確認事項を加えて、再度ご提示させていただきます。
シート名の指定ミス: マクロコード内の Set ws = ThisWorkbook.Sheets("Sheet1") の部分で、指定しているシート名が実際のExcelシート名と異なっている可能性があります。
"Sheet1" の部分を、作業したいシートの名前に正確に合わせてください。例えば、シート名が「データ」であれば "Data" に変更します。A列の改行コードの違い: Excelでセル内改行を行う際に、環境によって改行コードが vbLf (Line Feed) ではなく vbCrLf (Carriage Return + Line Feed) になっている場合があります。Split関数で区切る際に、この違いが影響している可能性があります。
Split 関数で指定する改行コードを vbCrLf に変更してみます。マクロの実行方法: マクロが正しく実行されていない、あるいは別のマクロが実行されている可能性も考えられます。
以下のコードでは、改行コードを vbCrLf に変更し、シート名の指定をより分かりやすくしました。また、A列のセルが空の場合の処理も確認しています。
Sub ExtractSpecificInfoToColumnC_Revised()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellValue As String
Dim lines() As String
Dim extractedInfo As String
Dim name As String
Dim customer As String
Dim supervisor As String
Dim targetSheetName As String ' 対象シート名を変数で管理
' ★★★ ここに対象のシート名を入力してください ★★★
targetSheetName = "Sheet1" ' 例: "Sheet1", "データ", "工事情報" など
' 指定されたシートが存在するか確認
On Error Resume Next ' エラーが発生しても処理を続行
Set ws = ThisWorkbook.Sheets(targetSheetName)
On Error GoTo 0 ' エラー処理を通常に戻す
' シートが存在しない場合のエラー処理
If ws Is Nothing Then
MsgBox "指定されたシート '" & targetSheetName & "' が見つかりません。シート名を確認してください。", vbCritical
Exit Sub ' マクロを終了
End If
' A列の最終行を取得します
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' C列に新しい列を挿入します
ws.Columns("C").Insert Shift:=xlToRight
' A列の各行を処理します
For i = 1 To lastRow
cellValue = ws.Cells(i, "A").Value
' セルが空でない場合のみ処理を実行
If Len(cellValue) > 0 Then
' ★★★ 改行コードを vbCrLf に変更 ★★★
lines = Split(cellValue, vbCrLf)
' 各項目を初期化
name = ""
customer = ""
supervisor = ""
extractedInfo = ""
' 分割された行をループして情報を抽出
Dim line As Variant
For Each line In lines
' 各行の前後の余分な空白を削除してから比較
Dim trimmedLine As String
trimmedLine = Trim(line)
If InStr(trimmedLine, "名前：") > 0 Then
' "名前：" の後から末尾までを抽出して前後の空白を削除
name = Trim(Mid(trimmedLine, InStr(trimmedLine, "名前：") + Len("名前：")))
ElseIf InStr(trimmedLine, "顧客：") > 0 Then
' "顧客：" の後から末尾までを抽出して前後の空白を削除
customer = Trim(Mid(trimmedLine, InStr(trimmedLine, "顧客：") + Len("顧客：")))
ElseIf InStr(trimmedLine, "監督：") > 0 Then
' "監督：" の後から末尾までを抽出して前後の空白を削除
supervisor = Trim(Mid(trimmedLine, InStr(trimmedLine, "監督：") + Len("監督：")))
End If
Next line
' 抽出した情報を結合してC列に書き込む（項目が存在する場合のみ）
If name <> "" Then
extractedInfo = extractedInfo & "名前：" & name & vbLf ' ここはvbLfで良い
End If
If customer <> "" Then
extractedInfo = extractedInfo & "顧客：" & customer & vbLf ' ここはvbLfで良い
End If
If supervisor <> "" Then
extractedInfo = extractedInfo & "監督：" & supervisor & vbLf ' ここはvbLfで良い
End If
' 結合した文字列の末尾に余分な改行があれば削除
extractedInfo = Trim(extractedInfo)
' C列に書き込み
ws.Cells(i, "C").Value = extractedInfo
ws.Cells(i, "C").WrapText = True ' 必要に応じて折り返し表示を有効にする
Else
' A列が空の場合はC列も空にする
ws.Cells(i, "C").Value = ""
End If
Next i
MsgBox "指定された情報の抽出と反映が完了しました！", vbInformation
End Sub
targetSheetName = "Sheet1" という行を追加しました。この "Sheet1" の部分を、実際に作業したいシートの名前に書き換えてください。lines = Split(cellValue, vbLf) を lines = Split(cellValue, vbCrLf) に変更しました。もし、これでうまくいかない場合は、元の vbLf に戻したり、両方を試したりしてみてください。Trim(line) を追加し、行の前後の余分な空白を削除するようにしました。これにより、意図しないマッチングを防ぎます。vbInformation を追加し、アイコンが表示されるようにしました。Alt + F11 キーでVBAエディターを開きます。targetSheetName = "Sheet1" の部分を、ご自身のシート名に合わせて修正してください。Alt + F8 キーでマクロダイアログを表示させます。ExtractSpecificInfoToColumnC_Revised を選択し、「実行」ボタンをクリックします。もし、それでも文字が反映されない場合は、以下の点について教えていただけますでしょうか？
お手数をおかけしますが、どうぞよろしくお願いいたします。一緒に解決策を見つけましょう！😊
C列に1列追加されただけで文字が反されていない
C列に1列追加されただけで文字が反映されていないとのこと、ご不便をおかけしております。🙇♀️
前回ご提示いただいたマクロコードに、A列のセルが空の場合でもC列が空になるように処理を追加しましたが、もしかしたらその部分で意図しない動作になっているか、あるいは他の要因で反映されていない可能性が考えられます。
再度、前回ご提案したマクロコードを以下に示します。もしよろしければ、このコードを再度ExcelのVBAエディターに貼り付けて、実行してみてください。
Sub ExtractSpecificInfoToColumnC()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellValue As String
Dim lines() As String
Dim extractedInfo As String
Dim name As String
Dim customer As String
Dim supervisor As String
' 作業対象のシートを指定します（必要に応じてシート名を変更してください）
Set ws = ThisWorkbook.Sheets("Sheet1")
' A列の最終行を取得します
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' C列に新しい列を挿入します
ws.Columns("C").Insert Shift:=xlToRight
' A列の各行を処理します
For i = 1 To lastRow
cellValue = ws.Cells(i, "A").Value
' セルが空でない場合のみ処理を実行
If Len(cellValue) > 0 Then
lines = Split(cellValue, vbLf) ' 改行コードで分割
' 各項目を初期化
name = ""
customer = ""
supervisor = ""
extractedInfo = ""
' 分割された行をループして情報を抽出
Dim line As Variant
For Each line In lines
If InStr(line, "名前：") > 0 Then
' "名前：" の後から末尾までを抽出して前後の空白を削除
name = Trim(Mid(line, InStr(line, "名前：") + Len("名前：")))
ElseIf InStr(line, "顧客：") > 0 Then
' "顧客：" の後から末尾までを抽出して前後の空白を削除
customer = Trim(Mid(line, InStr(line, "顧客：") + Len("顧客：")))
ElseIf InStr(line, "監督：") > 0 Then
' "監督：" の後から末尾までを抽出して前後の空白を削除
supervisor = Trim(Mid(line, InStr(line, "監督：") + Len("監督：")))
End If
Next line
' 抽出した情報を結合してC列に書き込む（項目が存在する場合のみ）
If name <> "" Then
extractedInfo = extractedInfo & "名前：" & name & vbLf
End If
If customer <> "" Then
extractedInfo = extractedInfo & "顧客：" & customer & vbLf
End If
If supervisor <> "" Then
extractedInfo = extractedInfo & "監督：" & supervisor & vbLf
End If
' 結合した文字列の末尾に余分な改行があれば削除
extractedInfo = Trim(extractedInfo)
' C列に書き込み
ws.Cells(i, "C").Value = extractedInfo
ws.Cells(i, "C").WrapText = True ' 必要に応じて折り返し表示を有効にする
Else
' A列が空の場合はC列も空にする
ws.Cells(i, "C").Value = ""
End If
Next i
MsgBox "指定された情報の抽出と反映が完了しました！"
End Sub
もし、このコードを再度実行しても文字が反映されない場合、いくつか確認したい点があります。
Set ws = ThisWorkbook.Sheets("Sheet1") の "Sheet1" は、実際に作業されているシート名と一致していますでしょうか？もし異なる場合は、正しいシート名に変更してください。A列のデータ形式: A列のデータは、前回例でいただいたような「ラベル：値」の形式で、各項目が改行で区切られていますでしょうか？例えば、以下のような形式です。
受番：4029B
名前：柴田 弘
顧客：ヤマダ
監督：熊倉090-9814-2432
もし、改行コードではなく、別の区切り文字（例: カンマやスペース）で区切られている場合や、そもそも「：」が含まれていない場合は、コードの修正が必要になります。
3. エラーメッセージ: マクロを実行した際に、何かエラーメッセージが表示されましたでしょうか？もし表示された場合は、そのメッセージを教えていただけますと、原因特定の手がかりになります。
お手数ですが、これらの点をご確認いただけますでしょうか。一緒に解決策を見つけましょう！😊
C列に1列追加されただけで文字が反されていない Excel2019
C列に1列追加されただけで文字が反されていない Excel2019
ご連絡ありがとうございます。マクロを実行してもC列に文字が反映されないとのこと、ご不便をおかけしております。🙇♀️
Excel 2019をご利用とのことですので、いくつか確認させていただきたい点がございます。
マクロの実行方法:
Alt + F8 でマクロダイアログを開き、「ExtractSpecificInfoToColumnC」を選択して「実行」ボタンを押しましたでしょうか？シート名:
Set ws = ThisWorkbook.Sheets("Sheet1") の部分で指定しているシート名は、実際に作業を行っているシート名と一致していますでしょうか？もしシート名が異なる場合は、コードの ("Sheet1") の部分を実際のシート名に変更して、再度実行してみてください。A列のデータ形式:
エラーメッセージの有無:
コードの貼り付け:
これらの点を確認させていただくことで、原因を特定しやすくなります。お手数ですが、ご確認いただけますと幸いです。😊
このチャットはプライベートです。投稿者のみがメッセージを送信できます。
チャット内容の閲覧は可能です。
48 件のコメント