ChatGPTもありますがCopilotも良いかも知れません。
Excelで数が多いときはExcelVBAの方が動きが速いです、Power Automate Desktopに比べれば。
なので今回はExcelVBAです。
ChatGPTにExcelVBAを聞いて
起動しないです。なぜでしょうね。
そのなぜを解明するのに時間がかかるようでは帰って、手でやった方がいいのではないかと思えて来ます。
起動しない理由を考えるのは骨が折れます。
もう諦めようと考えたときにふと、CopilotもAIなので相談に乗ってくれるかと考え
似たような質問（タイトル）のような質問を投げて見ました。
CopilotにExcelVBAを聞いて
Sub ProcessAllExcelsInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
' フォルダパスを指定します。
folderPath = "C:\path\to\your\folder" ' ここを適切なパスに変更してください。
' フォルダ内のすべてのExcelファイルを処理します。
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
' ワークブックを開きます。
Set wb = Workbooks.Open(folderPath & "\" & fileName)
' 2番目のワークシートを選択します。
Set ws = wb.Worksheets(2)
' "合計"の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。
Set rng = ws.Range("C12").End(xlToRight).End(xlToRight)
rng.Copy
' B12セルにペーストします。
ws.Range("B12").PasteSpecial Paste:=xlPasteAll
' ワークブックを保存して閉じます。
wb.Close SaveChanges:=True
' 次のファイルを処理します。
fileName = Dir
Loop
End Sub実行すると、C14がコピペされました。
ありがとう。 “合計”の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。 ここは、C12セルから合計という文字列が入ったセルの２つの右のセルを１列の範囲でこぴーしてほしい。 今はC12の２つ右のセルになっているよ。
加えて
バランス良く→厳密に変更して質問しました。
その結果
Sub ProcessAllExcelsInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
' フォルダパスを指定します。
folderPath = "C:\path\to\your\folder" ' ここを適切なパスに変更してください。
' フォルダ内のすべてのExcelファイルを処理します。
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
' ワークブックを開きます。
Set wb = Workbooks.Open(folderPath & "\" & fileName)
' 2番目のワークシートを選択します。
Set ws = wb.Worksheets(2)
' "合計"の文字列が入ったセルを探します。
For Each cell In ws.Range("C12:C1048576")
If cell.Value = "合計" Then
' "合計"の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。
Set rng = ws.Range(cell, cell.Offset(0, 2))
rng.Copy
' B12セルにペーストします。
ws.Range("B12").PasteSpecial Paste:=xlPasteAll
' ワークブックを保存して閉じます。
wb.Close SaveChanges:=True
' 次のファイルを処理します。
fileName = Dir
Exit Sub
End If
Next cell
Loop
End Sub実行すると画面が固まりました。
C1048576は合計という文字列の２つ右の変数という意味になっているのかな。
いえ、”C1048576″はExcelのセルのアドレスを指しています。Excelのワークシートには、行が1から1048576まで、列がAからXFDまであります。したがって、”C1048576″は、C列の最後の行、つまり1048576行目を指します。
このコードの中で、”C12:C1048576″は、C列の12行目から最後の行までの範囲を示しています。この範囲内で”合計”という文字列が入ったセルを探し、そのセルから2つ右のセルまでの範囲をコピーします。
したがって、”C1048576″は”合計”という文字列の2つ右の変数を意味しているわけではありません。ご理解いただけますでしょうか。
理解しました。 ただ、それなら私の伝え方が悪かったです。 “C12:C1048576″の範囲に合計という文字列はいません。A列の中にいます。 それを踏まえて、VBAコードを再作成お願いしたいです。
ご指摘いただきありがとうございます。A列に”合計”という文字列があるとのこと、理解しました。その情報を考慮に入れて、以下のようにVBAコードを修正しました。
Sub ProcessAllExcelsInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
' フォルダパスを指定します。
folderPath = "C:\path\to\your\folder" ' ここを適切なパスに変更してください。
' フォルダ内のすべてのExcelファイルを処理します。
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
' ワークブックを開きます。
Set wb = Workbooks.Open(folderPath & "\" & fileName)
' 2番目のワークシートを選択します。
Set ws = wb.Worksheets(2)
' A列で"合計"の文字列が入ったセルを探します。
For Each cell In ws.Range("A1:A1048576")
If cell.Value = "合計" Then
' "合計"の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。
Set rng = ws.Range(cell, cell.Offset(0, 2))
rng.Copy
' B12セルにペーストします。
ws.Range("B12").PasteSpecial Paste:=xlPasteAll
' ワークブックを保存して閉じます。
wb.Close SaveChanges:=True
' 次のファイルを処理します。
fileName = Dir
Exit Sub
End If
Next cell
Loop
End Subありがとう。惜しいです。 “合計”の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。 Set rng = ws.Range(cell, cell.Offset(0, 2)) rng.Copy ここはC12から “合計”の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。 以上の内容に変更できれば完璧です。
ご指摘いただきありがとうございます。”C12″から”合計”という文字列が入ったセルから2つ右のセルまでの範囲をコピーするように、以下のようにVBAコードを修正しました。
Sub ProcessAllExcelsInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
' フォルダパスを指定します。
folderPath = "C:\path\to\your\folder" ' ここを適切なパスに変更してください。
' フォルダ内のすべてのExcelファイルを処理します。
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
' ワークブックを開きます。
Set wb = Workbooks.Open(folderPath & "\" & fileName)
' 2番目のワークシートを選択します。
Set ws = wb.Worksheets(2)
' A列で"合計"の文字列が入ったセルを探します。
For Each cell In ws.Range("A1:A1048576")
If cell.Value = "合計" Then
' "C12"から"合計"の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。
Set rng = ws.Range("C12", cell.Offset(0, 2))
rng.Copy
' B12セルにペーストします。
ws.Range("B12").PasteSpecial Paste:=xlPasteAll
' ワークブックを保存して閉じます。
wb.Close SaveChanges:=True
' 次のファイルを処理します。
fileName = Dir
Exit Sub
End If
Next cell
Loop
End Sub実行で完成を確認しました。
しかし、繰り返しがうまくいかず一つのファイルしか実行されません。
あなたのコードが繰り返し処理を行わない理由は、Exit SubステートメントがIf cell.Value = "合計"の条件内にあるためです。このステートメントは、Subプロシージャを終了し、制御を呼び出し元のプロシージャに戻します。したがって、”合計”という値を持つ最初のセルを見つけた後、プロシージャは終了し、ループは次のファイルに移動しません。
この問題を解決するためには、Exit Subステートメントを削除するか、適切な場所に移動させる必要があります。以下に修正したコードを示します：
Sub ProcessAllExcelsInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
' フォルダパスを指定します。
folderPath = "C:\path\to\your\folder" ' ここを適切なパスに変更してください。
' フォルダ内のすべてのExcelファイルを処理します。
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
' ワークブックを開きます。
Set wb = Workbooks.Open(folderPath & "\" & fileName)
' 2番目のワークシートを選択します。
Set ws = wb.Worksheets(2)
' A列で"合計"の文字列が入ったセルを探します。
For Each cell In ws.Range("A1:A1048576")
If cell.Value = "合計" Then
' "C12"から"合計"の文字列が入ったセルから2つ右のセルまでの範囲をコピーします。
Set rng = ws.Range("C12", cell.Offset(0, 2))
rng.Copy
' B12セルにペーストします。
ws.Range("B12").PasteSpecial Paste:=xlPasteAll
' ワークブックを保存して閉じます。
wb.Close SaveChanges:=True
' 次のファイルを処理します。
Exit For
End If
Next cell
fileName = Dir
Loop
End Sub
この修正により、各Excelファイルが正しく処理され、”合計”という値を持つセルが見つかった場合にはそのファイルの処理が終了し、次のファイルに移動します。Exit Forステートメントは、現在のForループを終了し、制御をForステートメントの直後に移動します。これにより、各ファイルが正しく処理されます。この修正があなたの問題を解決することを願っています。もし他に質問があれば、お気軽にどうぞ。よろしくお願いいたします。🙂
成果物までつながればどちらでもいいのです
途中コード作成を諦めかけました。
2時間かけたけど、無駄だったかと。
ChatGPTが難しければ、Copilotでいいんです。無料で利用していてなんですが
成果につながればどちらでもいいです。
今回成果に繋がったのは、抽象的に言えば、2つ選択肢があったのが良かったです。
１つしかなくてそれがダメだと大変困りますし、立ち止まってしまいます。
どちらもダメだったらまあ難しいことだったのだろうと諦め、より詳しい専門家に聞くようにしたでしょう。
２つ以上手段を持って冷静になれるようにしておきましょう。
成果が出て成功体験を積んで行けば、事案が増えるのであのときのあのようにやればいけるかもしれないと
前向きにチャレンジできますよ。
｛今日のオフ｝
歯のメインテナンス
■相続相談