[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同じブックの複数のシートに同じマクロを実行したい』(ブルー)
いつもお世話になっております
同じブックの複数のシートに同じマクロを実行したいのですがどう書いたらよろしいでしょうか
< 使用 Excel:Excel2010、使用 OS:Windows7 >
もし1つの操作で複数のシートに適用するという意味なら
Sub 複数のシートで使うマクロ(Byval 対象のシート as Worksheet)
ここに処理
End Sub
という処理を用意し
Call 複数のシートで使うマクロ(対象のシート1)
Call 複数のシートで使うマクロ(対象のシート2)
という処理を書けばいいと思います。
(高橋) 2019/03/18(月) 20:33
シートを指定しなければ、 どのシートにも適用されるでしょうけど、 危なかしいですよね(^^;; (SoulMan) 2019/03/18(月) 20:48
例えば、どんなマクロですか?
ブルーさんの質問の仕方は、いつもそうですが、
具体的にやりたいことがあるのですよね。
(マナ) 2019/03/18(月) 21:48
Sub 登録馬処理1()
Dim 出馬表テスト As Worksheet Dim 処理後出馬表 As Worksheet Dim 元データ As Range
Set 処理後出馬表 = Worksheets("処理後1") Set 出馬表テスト = Worksheets("処理前1") Set 元データ = 出馬表テスト.UsedRange
Dim 最終行 As Long Dim 開始行 As Long Dim r As Long Dim shp As Shape
開始行 = 元データ(1, 1).Row 最終行 = 元データ.Rows.Count + 開始行
'レース名取得 Dim レース名 As String For r = 開始行 To 最終行 レース名 = 元データ(r, 2).Offset(2, 0) Exit For End If Next r '距離
Dim 距離 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then 距離 = 元データ(r, 3).Offset(4, -1) Exit For End If Next r
'日付 Dim 日付 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then 日付 = 元データ(r, 3).Offset(0, -1) Exit For End If Next r
'馬情報開始行取得 Dim 馬情報行 As Long For r = 開始行 To 最終行 If 元データ(r, 6) <> "" Then 馬情報行 = r + 2 Exit For End If Next r
'レース内容取得と書き出し Dim 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名 Dim cnt As Long cnt = 1 For r = 馬情報行 To 最終行 If 元データ(r, 6) <> "" Then
cnt = cnt + 1 'カウンタ
'データ取得 馬名 = 元データ(r, 1).Value 性齢毛色 = 元データ(r, 2).Value 斤量 = 元データ(r, 3).Value 調教師 = 元データ(r, 4).Value 父馬名 = 元データ(r, 5).Value 母馬名 = 元データ(r, 6).Value '******************************* 'この間はご自身で考えてコードを追加してください '*******************************
'データ書き出し 処理後出馬表.Cells(cnt, 1) = 馬名 処理後出馬表.Cells(cnt, 2) = 性齢毛色 処理後出馬表.Cells(cnt, 3) = 斤量 処理後出馬表.Cells(cnt, 4) = 調教師 処理後出馬表.Cells(cnt, 5) = 父馬名 処理後出馬表.Cells(cnt, 6) = 母馬名 処理後出馬表.Cells(cnt, 7) = レース名 処理後出馬表.Cells(cnt, 8) = 距離 処理後出馬表.Cells(cnt, 9) = 日付 '元データシート削除 '******************************* 'マクロの記録で記録されたコードを追加 '*******************************
End If Next r For Each shp In ActiveSheet.Shapes If shp.Name <> "スイッチ" Then shp.Delete Next Cells.Select Selection.ClearContents Sheets("処理後1").Select Selection.Cut Application.CutCopyMode = False Selection.Cut Sheets("登録").Select Range("c2").End(xlDown).Offset(1, 0).Select ActiveSheet.Paste Sheets("処理前1").Select End Sub というのを今は処理前1という名前のシートでしか実行できないのを 処理前2とか複数のシートに対して実行できるように改良したいのです わかりにくくすいませんがよろしくお願いします (ブルー) 2019/03/18(月) 22:30
シート名に決め事はあるのでしょうか。
例えば、必ず、処理後、処理前と数字からなるシート名であるとか。
(マナ) 2019/03/18(月) 22:50
処理後は、いつも同じシートという意味ですか。
ならば、SoulManさんの回答にあるように、
>Set 出馬表テスト = Worksheets("処理前1") ↓ Set 出馬表テスト = ActiveSheet
として、処理したいシートを選択してから
マクロを実行するとどうでしょうか。
ActiveSheetの名前を確認するコードを追加するとよいかもしれません。
(マナ) 2019/03/18(月) 23:03
(マナ) 2019/03/18(月) 23:12
Option Explicit Sub F()
Dim Ws As Worksheet Dim 出馬表テスト As Worksheet Dim 処理後出馬表 As Worksheet Dim 元データ As Range
Set 処理後出馬表 = Worksheets("処理後1") Set 出馬表テスト = ActiveSheet Set 元データ = 出馬表テスト.UsedRange
Dim 最終行 As Long Dim 開始行 As Long Dim r As Long Dim shp As Shape
開始行 = 元データ(1, 1).Row 最終行 = 元データ.Rows.Count + 開始行
For Each Ws In Worksheets Ws.Activate If Ws.Name Like "*あ*" Then 'レース名取得 Dim レース名 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then レース名 = 元データ(r, 2).Offset(2, 0) Exit For End If Next r '距離
Dim 距離 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then 距離 = 元データ(r, 3).Offset(4, -1) Exit For End If Next r
'日付 Dim 日付 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then 日付 = 元データ(r, 3).Offset(0, -1) Exit For End If Next r
'馬情報開始行取得 Dim 馬情報行 As Long For r = 開始行 To 最終行 If 元データ(r, 6) <> "" Then 馬情報行 = r + 2 Exit For End If Next r
'レース内容取得と書き出し Dim 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名 Dim cnt As Long cnt = 1 For r = 馬情報行 To 最終行 If 元データ(r, 6) <> "" Then
cnt = cnt + 1 'カウンタ
'データ取得 馬名 = 元データ(r, 1).Value 性齢毛色 = 元データ(r, 2).Value 斤量 = 元データ(r, 3).Value 調教師 = 元データ(r, 4).Value 父馬名 = 元データ(r, 5).Value 母馬名 = 元データ(r, 6).Value '******************************* 'この間はご自身で考えてコードを追加してください '*******************************
'データ書き出し 処理後出馬表.Cells(cnt, 1) = 馬名 処理後出馬表.Cells(cnt, 2) = 性齢毛色 処理後出馬表.Cells(cnt, 3) = 斤量 処理後出馬表.Cells(cnt, 4) = 調教師 処理後出馬表.Cells(cnt, 5) = 父馬名 処理後出馬表.Cells(cnt, 6) = 母馬名 処理後出馬表.Cells(cnt, 7) = レース名 処理後出馬表.Cells(cnt, 8) = 距離 処理後出馬表.Cells(cnt, 9) = 日付 '元データシート削除 '******************************* 'マクロの記録で記録されたコードを追加 '*******************************
End If Next r For Each shp In ActiveSheet.Shapes If shp.Name <> "スイッチ" Then shp.Delete Next ActiveSheet.Cells.Select Selection.ClearContents Sheets("処理後1").Select Selection.Cut Application.CutCopyMode = False Selection.Cut Sheets("登録").Select Range("c2").End(xlDown).Offset(1, 0).Select ActiveSheet.Paste End If Next Ws End Sub を作ってみたのですが 登録というシートの内容が何故か消えてしまいます 消える部分以外は大丈夫なのですが・・・
(ブルー) 2019/03/19(火) 21:01
多分..
For Each Ws In Worksheets Ws.Activate
の ws.Activateでシート名に関わりなくActiveにしている。
ActiveSheet.Cells.Select Selection.ClearContents
ここまで生きているので、登録シートの位置に依っては空白になるかも... Activeにする必要はあるとは思えませんが、
If Ws.Name Like "*あ*" Then Ws.Activate
に変更するとどうなるでしょう。
(seiya) 2019/03/19(火) 21:58
If Ws.Name Like "*あ*" Then Ws.Activate ですよね (ブルー) 2019/03/19(火) 22:38
>あ2のシートは消えています この意味が分かりません。
ActiveSheet.Cells.Select Selection.ClearContents
このActiveSheetはWs ですよね? Cells.ClearContentsしてしまって大丈夫ですか?
*あ*のシート全てクリアしてしまっていませんか?
Sheets("処理後1").Select Selection.Cut これも何をしているのか理解できません。 予めSheets("処理後1")のある範囲をSeletしているということですか? (seiya) 2019/03/19(火) 23:16
それと 1) Set 出馬表テスト = ActiveSheet 出馬表テストは状況によって参照が変わるのですか? そうでなければ、普通このような書き方はしません。
2) Dim レース名 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then レース名 = 元データ(r, 2).Offset(2, 0) Exit For End If Next r '距離 Dim 距離 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then 距離 = 元データ(r, 3).Offset(4, -1) Exit For End If Next r '日付 Dim 日付 As String For r = 開始行 To 最終行 If 元データ(r, 2).Value <> "" Then 日付 = 元データ(r, 3).Offset(0, -1) Exit For End If Next r '馬情報開始行取得 Dim 馬情報行 As Long For r = 開始行 To 最終行 If 元データ(r, 6) <> "" Then 馬情報行 = r + 2 Exit For End If Next r この4つのループはWsが変わるたびに同じ動きをしていますので外へ出してしまった方がすっきりしませんか?
(seiya) 2019/03/19(火) 23:31
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.