エクセルVBAについて質問です。


シートが灰色(デフォルトの色)かつ
シート名が半角数字(具体的には01~20)という、
2つの条件を同時に満たす全てのシートにおいて
(すでに作成している)マクロを実行せよというマクロを作ってください。

以前作成したマクロを、この条件でのみ動くようにしたいのです。
過去に似たような質問をしたのですが、
質問者が初心者のため応用できませんでした。
よろしくお願いします。

なお、下記の点にご留意ください。
①質問者は初心者なので、下記の回答者の方のように、
 それぞれのマクロがどう働くか「’」をもちいて説明してください。
  http://q.hatena.ne.jp/1190870363
②マクロは貼り付けてすぐに動くものをお願いします。
③質問が不明瞭でしたらコメントでご確認ください。

回答の条件
  • 1人2回まで
  • 登録:2008/01/04 16:48:28
  • 終了:2008/01/05 12:28:58

回答(2件)

id:Dark1984B No.1

黒ひよこ回答回数17ベストアンサー獲得回数02008/01/05 00:22:40

ポイント50pt

これでいけるでしょうか?

すでに作成しているマクロを下記の「マクロ」に置き換えて下さい。

ただ受け取ったワークシートに処理するように変更する必要があります



Sub シート抽出()

'変数定義

Dim BK1 As Workbook

Dim IN1 As Integer

Dim SH1 As Worksheet

Dim ST1(1 To 20) As String

'マクロを実行するシート名の全候補を配列変数に入れておく

For IN1 = 1 To 20

ST1(IN1) = Format(IN1, "00")

Next

'ワークシートをオブジェクト変数に取得

Set BK1 = ActiveWorkbook

For Each SH1 In BK1.Worksheets

'シート見出しが色なしで、シート名が01~20ならマクロ実行

If SH1.Tab.ColorIndex = xlColorIndexNone Then

For IN1 = 1 To 20

If SH1.Name = ST1(IN1) Then

Call マクロ(SH1)

Exit For

End If

Next

End If

Next

'完了処理

MsgBox "処理が完了しました"

End Sub

'以前作成したマクロは受け取ったワークシートに対して処理する

Sub マクロ(SHI1 As Worksheet)

SHI1.Range("A1") = "実行"

End Sub

id:taroemon

ご回答ありがとうございます。


上記のマクロに「マクロ」という文字が2つあったので、

それらを以前作成したマクロ名にしたところ、

実行を望んだシートのA1に「実行」の文字が表示されました。

実行したいシートの抽出は成功してます。

ただし、実行したいマクロが動きません。

これはどうしたら良いのでしょうか?


「受け取ったワークシートに処理するように変更する必要があります」

初心者丸出しで恥ずかしいのですが、

おっしゃってることがよくわかりません。

より具体的に教えていただけると幸いです。


急ぎで使いたいマクロなので、誰でも良いのでご回答ください。

以上、よろしくお願いします。

2008/01/05 11:25:05
id:ardarim No.2

ardarim回答回数892ベストアンサー獲得回数1422008/01/05 12:03:13

ポイント120pt

赤字の"マクロ"の部分を呼び出したいマクロ名に変更してください。

Option Explicit

Sub test()

    Dim sh As Worksheet
    
    For Each sh In ThisWorkbook.Worksheets
        If CheckSheet(sh) = True Then
            ' 該当シートに移動する
            sh.Select
            ' 実行したいマクロ名に置き換えてください
            Call マクロ
        End If
    Next sh

End Sub

' シートが条件に一致する場合のみ True を返す関数
Function CheckSheet(sh As Worksheet) As Boolean

    Dim i As Long
    Dim sheetName As String
        
    If sh.Tab.ColorIndex <> xlColorIndexNone Then
        ' 見出しがデフォルト色(灰色)ではないので False を返す
        CheckSheet = False
        Exit Function
    End If
    
    sheetName = sh.Name

    For i = 1 To Len(sheetName)
        If InStr("0123456789", Mid$(sheetName, i, 1)) = 0 Then
            ' シート名に半角数字以外の文字が含まれているので False を返す
            CheckSheet = False
            Exit Function
        End If
    Next i

    ' 条件に一致するので True を返す
    CheckSheet = True
    
End Function
id:taroemon

ご回答ありがとうございます。

完璧にうまくいきました。

2008/01/05 12:25:27

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません