Excel VBA質問箱 IV

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

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


7087 / 13646 ツリー ←次へ | 前へ→

【41307】Sheet1の特定セルの値の変更 初心者 06/8/4(金) 13:08 質問[未読]
【41308】Re:Sheet1の特定セルの値の変更 Blue 06/8/4(金) 13:14 回答[未読]
【41309】Re:Sheet1の特定セルの値の変更 初心者 06/8/4(金) 13:20 お礼[未読]

【41307】Sheet1の特定セルの値の変更
質問  初心者  - 06/8/4(金) 13:08 -

引用なし
パスワード
   あるフォルダに数個のbookがある場合に全てのbookのSheet1のA1の
値をA1 + "B"としたいのですが、現在全てのSheetのA1が変更されてしまいます
ソースは下記の物ですが、Sheet1のみ変更は可能でしょうか?
又、変更されたのを確認するのにセル色を赤にしたいのですが・・・

Sub test()
  Dim Filenm As String
  Dim Target As Worksheet
 
  Filenm = Dir(ThisWorkbook.Path & "\*.xls")
  Do Until Filenm = ""
    If Filenm <> ThisWorkbook.Name Then
      Workbooks.Open ThisWorkbook.Path & "\" & Filenm
      For Each Target In ActiveWorkbook.Worksheets
        With Target
          If .Range("A1").Value = "" Then
            .Range("A1").Value = "A"
          Else
            '.Range("A1").Value = .Range("A1").Value & "B"
          End If
        End With
      Next
      ActiveWorkbook.Save
      ActiveWorkbook.Close
    End If
    Filenm = Dir()
  Loop
  MsgBox "終了"
End Sub

【41308】Re:Sheet1の特定セルの値の変更
回答  Blue  - 06/8/4(金) 13:14 -

引用なし
パスワード
   >      For Each Target In ActiveWorkbook.Worksheets
>        With Target
>          If .Range("A1").Value = "" Then
>            .Range("A1").Value = "A"
>          Else
>            '.Range("A1").Value = .Range("A1").Value & "B"
>          End If
>        End With
>      Next
ここでBook中のすべてのシートをループして、A1を変更するような処理になっています。

名前がSheet1であるならば、

>      For Each Target In ActiveWorkbook.Worksheets
>      Next
を消して

Set Target = ActiveWorkbook.Worksheets("Sheet1")

にする。


一番左のシートならば、

>      For Each Target In ActiveWorkbook.Worksheets
>      Next
を消して

Set Target = ActiveWorkbook.Worksheets(1)

にするか、

>      Next
の上の行に、

Exit For

とでも付け足して記述しておけばよさそう。

【41309】Re:Sheet1の特定セルの値の変更
お礼  初心者  - 06/8/4(金) 13:20 -

引用なし
パスワード
   Blue さんへ
すばやい回答ありがとうございます。

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