[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『長年使ってきたフォーマットを変更したい』(mutsu)
いつもお世話になってます。&お願いします。
長年使ってきたフォーマットがあります。 このフォーマットを利用して、既に100近くのブックを作成しました。 (1ブック内にはシートが複数あります) 今回、このフォーマットに、列を1列追加しなければならなくなったので、 今まで作成してきたブックにもそれぞれ追加をしたいのです。 この場合、一つずつブックを開き追加していく方法しかないのでしょうか? よろしくお願いします。
VBAでフォルダ内の全て(あるいはブック名に特定の文字列が含まれるなどの指定も可能) のブックに対して同じ処理を行わせることが可能です。
べた書きで未検証ですが、こんな感じでいけると思います。
Sub test() Dim MyFol As String Dim MyF As String Dim MyBk As Workbook MyFol = "D:\test" MyF = Dir(MyFol & "*.xls") '指定フォルダ内の全てのブック Do While MyF <> "" Set MyBk = Workbooks.Open(MyFol & "\" & MyF) With MyBk.Worksheets("Sheet2").Range("C1") .EntireColumn.Insert .Value = "新しい項目名" End With With MyBk .Save .Close End With MyF = Dir() Loop End Sub (MARBIN)
間違いがありました。訂正します。
>MyF = Dir(MyFol & "*.xls") '指定フォルダ内の全てのブック ↓ MyF = Dir(MyFol & "\" & "*.xls") '指定フォルダ内の全てのブック
あと、画面の再描画停止、再開も必要かもしれません。 (MARBIN)
たびたびすみません。 ↑のコードだと、挿入した列(C列)ではなく、挿入前の 列(挿入後はD列)に"新しい項目名"が代入されてしまいますね。 ここはWithの外に出して別処理にしたほうがよさそう です。 (MARBIN)
MARBINさま、ありがとうございます。 このVBAは、新しいフォーマットに組み込めばよいのでしょうか?
>ここはWithの外に出して別処理にしたほうがよさそう すみません・・・どのようにしたら良いのでしょう? (mutsu)
>このVBAは、新しいフォーマットに組み込めばよいのでしょうか?
このVBAは使い捨てです。作業用に新規ブックを起動し、新規ブック の標準モジュールに記述してください。 処理が終わったら新規ブックは破棄してかまいません。
>>ここはWithの外に出して別処理にしたほうがよさそう > すみません・・・どのようにしたら良いのでしょう?
↓のようにしてみてください。
MyBk.Worksheets("Sheet2").Range("C1").EntireColumn.Insert MyBk.Worksheets("Sheet2").Range("C1").Value = "新しい項目名"
あるいは、↓のようにしてもいいと思います。 With MyBk.Worksheets("Sheet2").Range("C1") .EntireColumn.Insert .Offset(,-1).Value = "新しい項目名" End With (MARBIN)
MARBINさん、ありがとうございました。 きちんと動いてくれています♪
もう1つお聞きしたいのですが・・・ 選択したフォルダのブック内シート全てを作業対象にしたいのですが、 可能ですか? (シート名は全て違う名前が付いています。) お手数おかけいたしますが、よろしくお願いいたします。(mustu)
>選択したフォルダ
フォルダの選択もVBAで行いますか? それともセルなどに取得しておいたフォルダ に対して処理を行いますか?
なお、全シートに対しての処理は、 WorkSheets.Count でシート数を取得し、 WorkSheets(1) のようにシートインデックスで シートを指定して処理を行ないます。 あとは For 〜 Next などでループさせます。
また、フォルダ内の全ブックのシート構成が 同じなら、ループの外でシート数を変数か定数 で指定すれば無駄がなくなります。 (MARBIN)
MARBINさん、早速の回答ありがとうございます。 フォルダも多数あるので、VBAでの指定は任意フォルダの指定が出来るのであれば、嬉しいです。 とっても贅沢なお願いだと思いますが・・・・ シートの処理方法はこれから、ちょっといじってみます。 よろしくお願いします。(mutsu)
任意のフォルダ取得については、↓のINAさんのレスが参考になりそうです。
[[20040611124306]]
『フォルダ内のファイル一覧を表示するマクロ』(しげちゃん)
(MARBIN)
MARBINさん、お付き合いいただきありがとうございます。 しかしながら、私には抽象的過ぎて理解できない事が多いのが現状です。>< WorkSheets.Countは、前任者が作成したVBAにあったのを思い出したのですが、 結局、応用の仕方が分からず、・・・・・・って感じです。 出来の悪い生徒で本当に申し訳ないのですが、もう少しご教示いただけますでしょうか? (mutsu)
WorkSheets.Countは、対象ブックのワークシート数を 取得します。 前に何もつけてなかったらアクティブブックが対象に なります。
MyBk.WorkSheets.Count とすると、MyBkのワークシート数になります。
ただ、フォルダ内のブックのシート構成が全く同じな ら、ループの外でシート数を指定してもいいでしょう。 '変数の例 Dim ShtCnt As Long ShtCnt = 3
'定数の例 Const ShtCnt As Long = 3
でも、シート数が同じなら、↑のようなことは実は不要 です。 単純に↓のようなかんじでいいです。
For i = 1 to 3 MyBk.Worksheets(i).Range("C1")〜 ・ ・ Next i
変数や定数を使うなら↓のような感じになります。
Dim ShtCnt As Long ShtCnt = 3 For i = 1 to ShtCnt (MARBIN)
すみません><;分からないところを1つずつ質問させていただきたいのですが、 とんちんかんな質問をしそうなので、まずは、とんちんかんな修正をしたVBAを提出いたします。 とりあえず、こんな風に書き直すことしか出来ませんでした・・・「WorkSheets.Count」でエラーが出ます><;
Sub test() Dim MyFol As String Dim MyF As String Dim MyBk As Workbook Dim ShtCnt As Long
MyFol = "フォルダの指定" MyF = Dir(MyFol & "\" & "*.xls") '指定フォルダ内の全てのブック Do While MyF <> "" Set MyBk = Workbooks.Open(MyFol & "\" & MyF)
ShtCnt = 3 For i = 1 to ShtCnt
With MyBk.WorkSheets.Count.Range("C1") .EntireColumn.Insert .Offset(,-1).Value = "新しい項目名" End With With MyBk .Save .Close End With MyF = Dir() Next i End Sub
二つのループがごっちゃになってますよ。 Do〜Loop For 〜Next
↓のようになります。
Do While〜 〜 For〜 〜 Next 〜 Loop
>ShtCnt = 3
シート数が3で固定なら、 ループの外に出しましょう。 でないと、ループの数だけ再指定されるので無駄 です。
>With MyBk.WorkSheets.Count.Range("C1")
VBAヘルプで「Worksheet オブジェクト」を 調べてみてください。 そこにシートインデックスについての記述があります。
ここで、一休みです。 新規ブックで↓を試してみてください。
Sub test() Dim i As Long Dim wb As Workbook Dim shtcnt As Long Set wb = ActiveWorkbook shtcnt = wb.Worksheets.Count MsgBox shtcnt For i = 1 To shtcnt wb.Worksheets(i).Range("B2").Value = i * 5 Next i End Sub (MARBIN)
MARBINさん、何度もありがとうございます。 その後、データベースが1ブック1シートのみということが判明し、 ご教示いただいた内容をよ〜く理解するよう頭をフル回転させ、以下のようなものが 出来上がりました。 追加カラムのワイド設定がド素人丸出しですが、今更恥ずかしがるのもどうかと思い、 そのまま掲載いたします。^^; 先生いかがですか?
Sub test3() Dim MyFol As String Dim MyF As String Dim MyBk As Workbook MyFol = "フォルダ場所指定" MyF = Dir(MyFol & "\" & "*.xls") Do While MyF <> "" Set MyBk = Workbooks.Open(MyFol & "\" & MyF)
For i = 1 To 1 MyBk.Worksheets(i).Range("C1").EntireColumn.Insert MyBk.Worksheets(i).Range("C1").Value = "追加文字"
Columns("C").Select Selection.ColumnWidth = 5
With MyBk .Save .Close End With MyF = Dir()
Next i
Loop End Sub
↓は簡潔に出来ます。 というか、SelectやActivateを使うと 処理が遅くなったりする原因になりま すのでなるべく使わないようにしまし ょう。
> Columns("C").Select > Selection.ColumnWidth = 5 ↓ Columns("C").ColumnWidth = 5
また、これではブックやシートの指定がない ので予期しない結果になる可能性があります のでブック、シートの指定も入れましょう。
ほか、いろいろ細かいところを修正しました。
Sub test4() Dim MyFol As String Dim MyF As String Dim MyBk As Workbook MyFol = "フォルダ場所指定" MyF = Dir(MyFol & "\" & "*.xls") Do While MyF <> "" Set MyBk = Workbooks.Open(MyFol & "\" & MyF) With MyBk For i = 1 To 1 .Worksheets(i).Range("C1").EntireColumn.Insert .Worksheets(i).Range("C1").Value = "追加文字" .Worksheets(i).Columns("C").ColumnWidth = 5 .Save .Close Next i MyF = Dir() End With Loop End Sub
各ブックのシートが一つならループさせる必要はありません。 ↓でいけます。
Sub test5() Dim MyFol As String Dim MyF As String Dim MyBk As Workbook MyFol = "フォルダ場所指定" MyF = Dir(MyFol & "\" & "*.xls") Do While MyF <> "" Set MyBk = Workbooks.Open(MyFol & "\" & MyF) With MyBk .Worksheets(1).Range("C1").EntireColumn.Insert .Worksheets(1).Range("C1").Value = "追加文字" .Worksheets(1).Columns("C").ColumnWidth = 5 .Save .Close MyF = Dir() End With Loop End Sub (MARBIN)
MARBINさん、ありがとうございます。
1つずつステップアップ出来た♪という感じで、なんだか嬉しいです。 ありがとうございました!! 修正後のマクロ2つを見比べてさらに精進いたします。(mutsu)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.