「プロシージャの分け方について」助けてください…

質問

現在WorkSheet_changeプロシージャ内にかなりの記述量があり
プロシージャが大きすぎますとエラーが出てしまいました。
For文で回して少し削ってはいるのですが、どうしていいのかわかりません。。。
WorkSheet_changeプロシージャをまるまるコピーしてWorkSheet1_changeにしても反応してくれません。。

回答No.8

Wendy02

#7 の訂正です。
他のマクロを使っていて、Sh1 のオブジェクトが壊れることがありますから、その場合を想定して、以下のように、ErrHandler: の中を書き換えてください。

ErrHandler:
　　If Err.Number = 91 Then
　　　 Set Sh1 = Worksheets("Sheet1")
　　　 Resume
　　End If
　　Application.EnableEvents = True
End Sub

回答No.7

Wendy02

こんばんは。

>'(1)
>　If lngTargetRow = 46 And lngTargetCol = 4 Then
>　
>　　If Target.Cells(1, 1).Value <> "" _
>　　And ActiveSheet.Cells(lngTargetRow + 1, lngTargetCol) <> "" _
>　　And ActiveSheet.Cells(lngTargetRow + 2, lngTargetCol) <> "" Then

今、一通り、読めました。難しい書き方をしていますね。すぐに読めませんでした。コメントでも付けたほうがよいです。

その部分は、
n = Target.Row - ((rw + 2) Mod 3)
のようにして、先頭行を取り、3行を取ります。

ただし、まだ、ActiveSheet と Sh1 の区別があるのか分かりません。

それから、それが、別のシートだとすると、別のシートから、シートプロテクトの制御がうまく行きません。Protectの　UserInterfaceOnly を使ってください。

'------------------------------------------------
'　　**　標準モジュール　**
'------------------------------------------------
Public Sh1 As Worksheet
Sub Auto_Open()
Set Sh1 = Worksheets("Sheet1")
'Sh1 のシートを設定
Sh1.Protect UserInterfaceOnly:=True
End Sub

'------------------------------------------------
'　 **　シートモジュール　**
'------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim rw As Long
　　Dim i As Long, n As Long
　　Dim iColor As Integer
　　Dim LockFlg As Boolean

　　'入力が2個以上の場合は、無効
　　If Target.Count > 1 Then Exit Sub
　　'D列以外は、無効
　　If Target.Column <> 4 Then Exit Sub

　　On Error GoTo ErrHandler
　　Application.EnableEvents = False

　　rw = Target.Row
　　'180セット分
　　If rw >= 46 And rw <= 585 Then
　　　　'3行を1セットとする
　　　　n = Target.Row - ((rw + 2) Mod 3)
　　　　'3行が、1セットになるか判定
　　　　If WorksheetFunction.Count(Cells(n, 4).Resize(3)) = 3 Then
　　　　　　iColor = xlNone
　　　　　　LockFlg = False
　　　　Else
　　　　　　iColor = 15
　　　　　　LockFlg = True
　　　　End If
　　　　For i = 10 To 64 Step 6
　　　　　　With Sh1.Cells(i, 10).Resize(3)
　　　　　　　　.Interior.ColorIndex = iColor
　　　　　　　　.Locked = LockFlg
　　　　　　End With
　　　　Next i
　　End If
ErrHandler:
　　Application.EnableEvents = True
End Sub

回答No.6

Wendy02

こんにちは。

今のところは、私は、単なるアドバイスしか出来ません。
最初に、イベント・ドリブン型に入れること自体が無理がありますね。

64kb の壁という話も出てくるかもしれませんが、#1 のコードが読めないですね。
これは、基になっている本体自体は、一通り分かっている人のコードだと思います。それを、単につなげただけのようです。

それは、改めてコードを書き直したほうがよいです。内容は、非常に簡単で単純なもののようです。それを公式化が出来ていないので、個別のコードになっているのだと思います。

それに、コードの中の、ActiveSheet とSh1 の関係性が見えてこないのです。

イベント・ドリブン型マクロには、ActiveSheet というものはありません。Sh1 と出てくる場所はどこかも分かりません。

それから、lngTargetRow　というのは、単に、Target.Row か、Target.Cells(1).Row のことだと思います。

それに、これは、みんな場所が同じところを繰り返しているだけですね。
-----------------------------------------------
それに、これ自体(2)、ループが必要なほどの量でもなさそうです。
---------------------------------------------------
'(2)
　For i = 10 To 64 Step 6
　　　　　　　　Sh1.Range(Sh1.Cells(i, 10), Sh1.Cells(i + 2, 10)).Locked = False
　　　　　　　　Sh1.Range(Sh1.Cells(i, 10), Sh1.Cells(i + 2, 10)).Interior.ColorIndex = xlNone
　　　　　　Next i
-------------------------------------------------　　　　　　
(1)の意味が良く分からないです。

この(1)の意味さえ、解ければ、後は、すべて統一できるはずです。
行によって、lngTargetRow （+1,+2,-1...） の周辺の位置が変わっているようですが、そこの説明を受けないと分かりません。

何か、囲碁のような連想をさせます。しかし、(2)の色塗りとLock の位置は、皆、定位置同じだから、あまり意味がありません。
---------------------------------------------------
'(1)
　If lngTargetRow = 46 And lngTargetCol = 4 Then

　　If Target.Cells(1, 1).Value <> "" _
　　And ActiveSheet.Cells(lngTargetRow + 1, lngTargetCol) <> "" _
　　And ActiveSheet.Cells(lngTargetRow + 2, lngTargetCol) <> "" Then
---------------------------------------------------
何か、入力したセルの周りが、"" だったら実行しろというようなコードのようですね。

それに、lngTargetRow = 46　の同じようなものがいくつもあるようだけれども、
単に、lngTargetRow >=46 ということのような気がします。

今、やろうとしている詳しい説明を請けて、新たにコードを書き直したほうが良いと思います。そんなに難しいことをしているようには思えません。数列の公式を見つければ可能だと思います。

回答No.5

lark_0925

ちょっと訂正

Private Sub Worksheet_Change(ByVal Target As Range)
　　Call chk_and_set_data(46, 47, 4, 48, 4,target)
　　Call chk_and_set_data(47, 46, 4, 48, 4,target)
　　Call chk_and_set_data(48, 47, 4, 46, 4,target)
End Sub
'===============================================================
Sub chk_and_set_data(rw As Long, crw1 As Long, ccol1 As Long, crw2 As Long, ccol2 As Long,target as range)
　　Dim i As Long
　　Dim sht1 As Worksheet
　　dim lngTargetRow as long
　　dim lngTargetCol as long
　　lngTargetRow=target.row
　　lngTargetCol=target.column
　　Set sht1 = Worksheets(1) '適切なシートをセット
　　sht1.Unprotect
　　If lngTargetRow = rw And lngTargetCol = 4 Then
　　　vntCellValue = Target.Cells(1, 1).Value
　　　If vntCellValue <> "" And _
　　　　　　ActiveSheet.Cells(crw1, ccol1) <> "" And _
　　　　　　ActiveSheet.Cells(crw2, ccol2) <> "" Then
　　　　　For i = 10 To 64 Step 6
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = False
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = xlNone
　　　　　　Next i
　　　Else
　　　　　For i = 10 To 64 Step 6
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = 15
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = True
　　　　　　Next i
　　　　　End If
　　　End If
　　sht1.Protect
End Sub

回答No.4

lark_0925

まだ全体像がわかりません。
コードしか掲載してもらえないからです（勿論、コードは必要ですが）。
やりたいことを仕様書として掲載が本来は必要です。

提示されたコードだけを見ると(これも省略掲載なので、この変数が何か
等不明な点がありますが）、

'===============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
　　Call chk_and_set_data(46, 47, 4, 48, 4)
　　Call chk_and_set_data(47, 46, 4, 48, 4)
　　Call chk_and_set_data(48, 47, 4, 46, 4)
End Sub
'===============================================================
Sub chk_and_set_data(rw As Long, crw1 As Long, ccol1 As Long, crw2 As Long, ccol2 As Long)
　　Dim i As Long
　　Dim sht1 As Worksheet
　　Set sht1 = Worksheets(1) '適切なシートをセット
　　sht1.Unprotect
　　If lngTargetRow = rw And lngTargetCol = 4 Then
　　　vntCellValue = Target.Cells(1, 1).Value
　　　If vntCellValue <> "" And _
　　　　　　ActiveSheet.Cells(crw1, ccol1) <> "" And _
　　　　　　ActiveSheet.Cells(crw2, ccol2) <> "" Then
　　　　　For i = 10 To 64 Step 6
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = False
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = xlNone
　　　　　　Next i
　　　Else
　　　　　For i = 10 To 64 Step 6
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = 15
　　　　　　SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = True
　　　　　　Next i
　　　　　End If
　　　End If
　　sht1.Protect
End Sub

はっきり内容を把握していないので
正しく機能分割されていないかもしれません。

回答No.3

noname#79209

> 下記記述コードをそのままSub Sub1()とし、
> 標準モジュールに突っ込んでみましたが、
> Call Sub1で呼び出すことができません。。
プロシージャの頭は
Public Sub
となっていますか？
別モジュール置いて呼び出すプロシージャは、
パブリックでないと呼び出せません。

回答No.2

imogasi

内容的にまとまった部分をSuBプロシージャーに分けて（どちらかというと無理やりに）（引数で変数データを渡さなくて良い単位にできればなお良い）
Private Sub Worksheet_Change(ByVal Target As Range)
ここにある程度主要な部分は今のまま温存しておき
Call　SUB1
Call　Sub2
・・・・

End Sub
のようにしてみましたか。Callは不要。
Sub Sub1()
切り分けたコード
End Sub
Sub Sub2()
切り分けたコード
End Sub

補足

下記記述コードをそのままSub Sub1()とし、標準モジュールに突っ込んでみましたが、Call Sub1で呼び出すことができません。。
プログラム自体まだまだ不慣れなもので。。。
下記記述コードをそのままSub Sub1()とすること自体が間違っているのでしょうか…

回答No.1

lark_0925

どんなコードなのか見なければはっきりしたことは言えません。
が、プログラムの基本形は、

　　前処理
　　　｜
　　　｜
　一回以上のループ処理
　　　｜
　　　｜
　　後処理

私は、この基本形にコードを整えることを考えます。

まずは、前処理や後処理が別のプロシジャーに分割できるか

検討してください。

プロシジャー分割と言うのは、
トップダウンとボトムアップに仕様を検討して、後々メンテしやすい
ようにコードを分割していくものです。
慣れないと難しいところもあるかもしれませんね！！

補足

プログラムコードとしては、
下記のようなものになります。

下記を1セットとし、180セット記述します。。。

If lngTargetRow = 46 And lngTargetCol = 4 Then
vntCellValue = Target.Cells(1, 1).Value
If vntCellValue <> "" And ActiveSheet.Cells(lngTargetRow + 1, lngTargetCol) <> "" And ActiveSheet.Cells(lngTargetRow + 2, lngTargetCol) <> "" Then
SH1.Unprotect
For i = 10 To 64 Step 6
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = False
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = xlNone
Next i
SH1.Protect
Else
SH1.Unprotect
For i = 10 To 64 Step 6
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = 15
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = True
Next i
SH1.Protect
End If

End If

If lngTargetRow = 47 And lngTargetCol = 4 Then
vntCellValue = Target.Cells(1, 1).Value
If vntCellValue <> "" And ActiveSheet.Cells(lngTargetRow - 1, lngTargetCol) <> "" And ActiveSheet.Cells(lngTargetRow + 1, lngTargetCol) <> "" Then
SH1.Unprotect
For i = 10 To 64 Step 6
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = False
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = xlNone
Next i
SH1.Protect
Else
SH1.Unprotect
For i = 10 To 64 Step 6
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = 15
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = True
Next i
SH1.Protect
End If

End If

If lngTargetRow = 48 And lngTargetCol = 4 Then
vntCellValue = Target.Cells(1, 1).Value
If vntCellValue <> "" And ActiveSheet.Cells(lngTargetRow - 1, lngTargetCol) <> "" And ActiveSheet.Cells(lngTargetRow - 2, lngTargetCol) <> "" Then
SH1.Unprotect
For i = 10 To 64 Step 6
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = False
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = xlNone
Next i
SH1.Protect
Else
SH1.Unprotect
For i = 10 To 64 Step 6
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Interior.ColorIndex = 15
SH1.Range(SH1.Cells(i, 10), SH1.Cells(i + 2, 10)).Locked = True
Next i
SH1.Protect
End If

End If