[[20060727212919]] 『長年使ってきたフォーマットを変更したい』(mutsu) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『長年使ってきたフォーマットを変更したい』(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.