Pythonでエクセルファイルの内容を別のエクセルファイルにコピー&ペーストしたい

Comments

1. 

   @marron_117

   Questioner

   more_horiz

   Pythonへのこだわりはありません。指南いただけると幸いです。

2. 

   @marron_117

   Questioner

   more_horiz

   chatgptを用いてvbaで書いてみたのですがこのようになりました。

   Sub データコピーと整形()
   
       Dim wsSource As Worksheet
       Dim srcRow As Long
       Dim targetFile As String
       Dim industryName As String
       Dim wb As Workbook
       Dim ws As Worksheet
       
       ' ソースファイルを設定（既に開いているものとします）
       Set wsSource = ThisWorkbook.Sheets("株価チャート") ' ソースファイルのシート名を指定
       
       ' 「業界名」を入力
       industryName = InputBox("業界名を入力してください:", "業界名の入力")
       If industryName = "" Then Exit Sub ' キャンセルが選択された場合、処理終了
       
       srcRow = 2 ' ソースファイルの開始行を指定
       
       ' ターゲットファイルを設定
       targetFile = Environ("USERPROFILE") & "\Desktop\" & industryName & "\" & "特許価値_" & industryName & ".xlsx" ' ユーザーデスクトップのパスに保存
       
       ' ターゲットファイルを開く
       Set wb = Workbooks.Open(targetFile)
       
       ' A2からデータのないセルまで繰り返し
       Do Until wsSource.Cells(srcRow, 1).Value = ""
           ' A列の名前と同じ名前のエクセルファイルを開く
           On Error Resume Next
           Set ws = wb.Sheets(wsSource.Cells(srcRow, 1).Value)
           On Error GoTo 0
           
           If Not ws Is Nothing Then
               ' B列内のセル内容と一致した場合、該当セルの一つ下から二つ上までの行をコピー
               If ws.Cells(1, 2).Value = wsSource.Cells(srcRow, 2).Value Then
                   wsSource.Cells(srcRow - 2, 1).Resize(3, wsSource.Cells(srcRow, Columns.Count).End(xlToLeft).Column).Copy
                   ws.Cells(1, 1).Insert xlShiftDown ' データがある場合は1行開けてペースト
               End If
           End If
           
           srcRow = srcRow + 1 ' 次の行に移動
       Loop
       
       ' ターゲットファイルを保存
       wb.Save
       wb.Close
       
       ' ターゲットファイルを再度開く
       Set wb = Workbooks.Open(targetFile)
       
       ' A2からデータのないセルまで繰り返し
       srcRow = 2 ' ソースファイルの開始行を再設定
       Do Until wsSource.Cells(srcRow, 1).Value = ""
           ' A列の名前と同じ名前のシートに移動
           On Error Resume Next
           Set ws = wb.Sheets(wsSource.Cells(srcRow, 1).Value)
           On Error GoTo 0
           
           ' B列からH列、J列、K列、M列を削除
           If Not ws Is Nothing Then
               ws.Range("B:H,J:J,K:K,M:M").Delete Shift:=xlToLeft
           End If
           
           srcRow = srcRow + 1 ' 次の行に移動
       Loop
       
       ' ターゲットファイルを再度保存
       wb.Save
       wb.Close
   
   End Sub
   
   

   これで行うとファイルが存在するはずの場所を指定しているにもかかわらず、ファイルが存在しないと言われてしまいます。ファイル名を日本語ではなくローマ字などに変えた方がいいでしょうか？

3. 

   @nak435

   more_horiz

   赤字のコメントを理解して使ってください。

   

   以下、VBAコード（自分の環境で動作確認済み）
   （Microsoft 365 Excel for Mac version 16.76 (23081101））
   OSに依存するコードはないので、Windowsでも動くはずです

   Sub example()
   
       Application.ScreenUpdating = False
   
       Dim srcRow As Long
       Dim myPath As String, myDir As String, mySheet As Worksheet
       Set mySheet = ThisWorkbook.ActiveSheet
       myPath = ThisWorkbook.FullName
       myDir = Left(myPath, Len(myPath) - Len(ThisWorkbook.Name))
       
       srcRow = 2
       Do While (Not IsEmpty(Cells(srcRow, 1))) And (Not IsEmpty(Cells(srcRow, 2)))
           Dim company As String, companySheet As Worksheet
           company = Cells(srcRow, 1)
           Dim tagetPath As String
           tagetPath = myDir & company & ".xlsx"
           
           Set companySheet = ThisWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
           ActiveSheet.Name = company
           
           Dim targetBook As Workbook
           Set targetBook = Application.Workbooks.Open(FileName:=tagetPath, ReadOnly:=True, UpdateLinks:=False)
       
           Dim r As Variant, r0 As Variant: r = r0
           On Error Resume Next
           r = Application.WorksheetFunction.Match(mySheet.Cells(srcRow, 2), targetBook.ActiveSheet.Columns(1), 0)
           On Error GoTo 0
           If IsEmpty(r) Then
               companySheet.Cells(1, 1) = "not found same date!"
   
           Else
               Dim row As Integer: row = CInt(r)
               With targetBook.ActiveSheet
                   .Range(.Rows(row - 2), .Rows(row + 1)).Copy
               End With
               companySheet.Activate
               ActiveSheet.Cells(1, 1).Select
               ActiveSheet.Paste
               Application.CutCopyMode = False
               
               ActiveSheet.Range("B:H,J:K,M:M").Delete Shift:=xlToLeft
           End If
           
           targetBook.Close savechanges:=False
           mySheet.Activate
           srcRow = srcRow + 1
       Loop
   
       Application.ScreenUpdating = True
   
   End Sub
   

4. 

   @marron_117

   Questioner

   more_horiz

   返事が遅くなり申し訳ございません。動くことができました。ありがとうございます！

5. 

   @nak435

   more_horiz

   お役に立ててよかったです☺️