Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


40604 / 76736 ←次へ | 前へ→

【41228】Re:複数あるbook(数シート)の特定セルの内容変更
発言  へっぽこ  - 06/8/2(水) 15:05 -

引用なし
パスワード
   こんにちは。

簡単なサンプルですが研究してみてください。

'------------------------------------------------------------------------------
'同じフォルダに存在するブックのA1セルを書き換えるので注意して実行してください。
'------------------------------------------------------------------------------
Sub サンプル()
  Dim ファイル名 As String
  Dim 各シート As Worksheet
  
  If ThisWorkbook.Path = "" Then
    MsgBox "いったん保存してください。"
    Exit Sub
  End If
  '1.マクロを書いたブックと同じフォルダの中から(ThisWorkbook.Path)
  ' 「*.xls」という名前のファイル名を取得する。
  ' (ここでは最初の1ファイル分の名前を受け取る)
  ファイル名 = Dir(ThisWorkbook.Path & "\*.xls")
  '2.1や8でファイル名が取得できなくなるまでDo〜Loopを繰り返す。
  Do Until ファイル名 = ""
    '3.取得したファイル名がマクロを書いたブックの名前(ThisWorkbook.Name)
    ' と違うならばIf〜End If内を処理する。
    ' (マクロを書いたブックの名前でも処理するとオープンするときに
    '  「既に開いてます。2重に開くと…」とメッセージが出るのでそれを避けるため)
    If ファイル名 <> ThisWorkbook.Name Then
      '4.取得したファイル名のブックを開く。
      Workbooks.Open ThisWorkbook.Path & "\" & ファイル名
      '5.4で開いたブックの全ワークシートを一つ一つ処理する。
      For Each 各シート In ActiveWorkbook.Worksheets
        With 各シート
          '6.A1セルが空っぽなら"A"と設定し、何か入っていれば後ろに"B"を付ける。
          If .Range("A1").Value = "" Then
            .Range("A1").Value = "A"
          Else
            .Range("A1").Value = .Range("A1").Value & "B"
          End If
        End With
      Next
      '6.4で開いたブックを保存する。
      ActiveWorkbook.Save
      '7.4で開いたブックを閉じる。
      ActiveWorkbook.Close
    End If
    '8.次のファイル名を取得する。
    '(1で指定した条件「*.xls」を満たすファイル名の2番目以降を取得)
    ファイル名 = Dir()
  Loop
  MsgBox "終了しました。"
End Sub
0 hits

【41221】複数あるbook(数シート)の特定セルの内容変更 初心者 06/8/2(水) 12:09 質問
【41222】Re:複数あるbook(数シート)の特定セルの... Statis 06/8/2(水) 12:26 発言
【41224】Re:複数あるbook(数シート)の特定セルの... 初心者 06/8/2(水) 12:56 発言
【41228】Re:複数あるbook(数シート)の特定セルの... へっぽこ 06/8/2(水) 15:05 発言
【41263】Re:複数あるbook(数シート)の特定セルの... 初心者 06/8/3(木) 13:23 お礼

40604 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free