エクセル:シートを切り替えずに別シート上の操作をする
タイトルが正しいかどうか疑問ですが。
シート[Sheet1]にて値を入力したアドレス(の行番号と列番号)を取得し、
その周囲のセルの罫線の色を赤(3)から灰色(15)に置換するコードを作っています。
Sheet1のコードには、
Private Sub Worksheet_Change(ByVal Target As Range)
AAA Target
End Sub
とだけ書き、入力があったらプロシージャAAAへTargetを持って飛びます。
Sub AAA(ByVal Target As Range)
Dim M_Row As Integer
Dim M_Clm As Integer
Dim Y As Range
M_Row = Target.Row
M_Clm = Target.Column
For Each Y In Worksheets("Sheet1").Range(Cells(M_Row - 2, M_Clm), Cells(M_Row + 1, M_Clm + 5))
With Y
If .Borders(xlEdgeTop).ColorIndex = 3 Then .Borders(xlEdgeTop).ColorIndex = 15
If .Borders(xlEdgeLeft).ColorIndex = 3 Then .Borders(xlEdgeLeft).ColorIndex = 15
If .Borders(xlEdgeBottom).ColorIndex = 3 Then .Borders(xlEdgeBottom).ColorIndex = 15
End With
Next
End Sub
ここまでは正常に動きます。
この後に、アクティブでないシート[Sheet2]の同じセル範囲にある罫線の色も同じように置換したいので、
上記コードに続けて、以下のように書きました。
Sub AAA(ByVal Target As Range)
Dim M_Row As Integer
Dim M_Clm As Integer
Dim Y As Range
M_Row = Target.Row
M_Clm = Target.Column
For Each Y In Worksheets("Sheet1").Range(Cells(M_Row - 2, M_Clm), Cells(M_Row + 1, M_Clm + 5))
With Y
If .Borders(xlEdgeTop).ColorIndex = 3 Then .Borders(xlEdgeTop).ColorIndex = 15
If .Borders(xlEdgeLeft).ColorIndex = 3 Then .Borders(xlEdgeLeft).ColorIndex = 15
If .Borders(xlEdgeBottom).ColorIndex = 3 Then .Borders(xlEdgeBottom).ColorIndex = 15
End With
Next
For Each Y In Worksheets("Sheet2").Range(Cells(M_Row - 2, M_Clm), Cells(M_Row + 1, M_Clm + 5))
With Y
If .Borders(xlEdgeTop).ColorIndex = 3 Then .Borders(xlEdgeTop).ColorIndex = 15
If .Borders(xlEdgeLeft).ColorIndex = 3 Then .Borders(xlEdgeLeft).ColorIndex = 15
If .Borders(xlEdgeBottom).ColorIndex = 3 Then .Borders(xlEdgeBottom).ColorIndex = 15
End With
Next
End Sub
これだと、
For Each Y In Worksheets("Sheet2").Range(Cells(M_Row - 2, M_Clm), Cells(M_Row + 1, M_Clm + 5))
の部分で失敗します。
この1行前に、
Sheets("Sheet2").Select
と入れてやると正常に動作するのですが、
シートを切り替えずにやりたいと思っています。
可能でしょうか?
以下のように、
実行後にSheet1に戻し、
それらを
Application.ScreenUpdating = False
Application.ScreenUpdating = True
で挟むことで、見た目はシートを切り替えずに実行できるのですが、
実際にこのコードを組み込んでいるシートはシート上にあるデータが多いためか(600行×100列程度)、
全く同じコードを実行しても一瞬画面がチラついてしまいます。
(新規Bookで同じコードを組み込んで、何行かに罫線を引いただけのシートだと全くチラつかなかったので、
シート上のデータが多いせいじゃないかと思いました)
Sub AAA(ByVal Target As Range)
Dim M_Row As Integer
Dim M_Clm As Integer
Dim Y As Range
M_Row = Target.Row
M_Clm = Target.Column
For Each Y In Worksheets("Sheet1").Range(Cells(M_Row - 2, M_Clm), Cells(M_Row + 1, M_Clm + 5))
With Y
If .Borders(xlEdgeTop).ColorIndex = 3 Then .Borders(xlEdgeTop).ColorIndex = 15
If .Borders(xlEdgeLeft).ColorIndex = 3 Then .Borders(xlEdgeLeft).ColorIndex = 15
If .Borders(xlEdgeBottom).ColorIndex = 3 Then .Borders(xlEdgeBottom).ColorIndex = 15
End With
Next
Application.ScreenUpdating = False
Sheets("Sheet2").Select
For Each Y In Worksheets("Sheet2").Range(Cells(M_Row - 2, M_Clm), Cells(M_Row + 1, M_Clm + 5))
With Y
If .Borders(xlEdgeTop).ColorIndex = 3 Then .Borders(xlEdgeTop).ColorIndex = 15
If .Borders(xlEdgeLeft).ColorIndex = 3 Then .Borders(xlEdgeLeft).ColorIndex = 15
If .Borders(xlEdgeBottom).ColorIndex = 3 Then .Borders(xlEdgeBottom).ColorIndex = 15
End With
Next
Sheets("Sheet1").Select
Application.ScreenUpdating = True
End Sub
よろしくお願いします。
お礼
ありがとうございます。 とても分かりやすくて勉強になりました。^^