| |
問題なく実行できました。
ありがとうございました。
一度に１００単位のブックを処理していたので非常に助かります。
ただ、いただいたコードでは
保存の際にこれまでと同様に拡張子に関するエラーが出ていたので、
templateの拡張子をxlsm -> xlsxに変更したところ、
問題なく実行できました。
（もともとxlsmである必要はなかった）
fとしてコピーしたファイル形式とtemplateのファイル形式が
異なっていたために起こったエラーでしょうか。
最終的なコードは以下です。
ありがとうございました。
Sub macro()
Dim folder1 As String
Dim folder2 As String
Dim template As String
Dim f As String
Dim wbT As Workbook
Dim wb As Workbook
' 使いませんので、削除
' Dim strWorkBookName As String
folder1 = "C:\Users\tsuruta\Documents\macro\folder1" 'フォルダ１
folder2 = "C:\Users\tsuruta\Documents\macro\folder2" 'フォルダ２
template = "C:\Users\tsuruta\Documents\macro\template.xlsx" 'テンプレートBook
' f = Dir(folder1 & "\" & "1.xlsx") 'フォルダ１内の最初のBook名
' これでは、『C:\Users\tsuruta\Documents\macro\folder1\1.xlsx』しか
' 処理の対象になりませんので、下記のように変更
f = Dir(folder1 & "\*.xlsx") 'フォルダ１内のxlsxファイルを取得
Do While f <> "" 'Book名がある間
Set wbT = Workbooks.Open(template) 'テンプレートを開く
' Set wb = Workbooks.Open(folder1 & "\" & "1.xlsx") '生データを開く
' ここもこのままでは、
' 『C:\Users\tsuruta\Documents\macro\folder1\1.xlsx』しか
' 処理の対象になりませんので、下記のように変更。
' 変数『f』には開く対象のファイル名が取得されていますので
' それを使用してOpenするBookのFullPathを生成。
Set wb = Workbooks.Open(folder1 & "\" & f) '生データを開く
wb.Worksheets("Sheet1").Range("B:B").Copy '生データのBookのSheet1のB列の値をコピー
wbT.Worksheets("Sheet1").Range("B:B").PasteSpecial 'コピーした値をテンプレートのSheet1のB列にペースト
Application.CutCopyMode = False 'クリップボード停止（警告回避）
' strWorkBookName = ActiveWorkbook.Name '生データのファイル名をコピー
' 変数fにファイル名が取得ずみです。ここは不要になります。
wb.Close False '生データを保存せずに閉じる
'以下ソルバー実行
SolverReset
SolverOk SetCell:="$G$5", MaxMinVal:=2, ValueOf:=0, ByChange:="$J$3:$J$6", _
Engine:=1, EngineDesc:="GRG Nonlinear"
Application.DisplayAlerts = False
SolverSolve True
Application.DisplayAlerts = True
'ソルバー終了
' wbT.Close True, folder2 & "\" & strWorkBookName 'テンプレートの結果を元のファイル名でフォルダ２に保存して閉じる
' 変数fを使用して、Folder2へ同名保存。
wbT.Close True, folder2 & "\" & f
f = Dir 'フォルダ１内の次のBook名
Loop '繰り返す
End Sub
|
|
ぺーぺー
- 13/7/3(水) 13:36 -
