またまたEXCELmacroについて

質問

お世話になります。
EXCEL 2016にて　或る表に対して以下のようなmacroを組みました。
動きは思った通りに動いてくれるので問題無いのですが、繰り返しが意外に多くなってしまい、もっとうまいまとめ方が有るように思えてきました。

Select Case 文をまとめるか、別Procにするかで悩んでいます。よろしかったらアドバイスをお願いします。
----------------------------------------------------------------------
Sub seikatsu()
With ActiveWindow
If ActiveCell.Column > 5 And ActiveCell.Column < 37 Then
Select Case ActiveCell.Row
Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 6
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 6
End Select
ElseIf ActiveCell.Column > 43 And ActiveCell.Column < 51 Then
Select Case ActiveCell.Row
Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 44
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 44
End Select
ElseIf ActiveCell.Column > 54 And ActiveCell.Column < 62 Then
Select Case ActiveCell.Row
Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 55
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 55
End Select
ElseIf ActiveCell.Column > 65 And ActiveCell.Column < 80 Then
Select Case ActiveCell.Row
Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 66
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 66
End Select
Else
Select Case ActiveCell.Row
Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 6
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 6
End Select
End If
End With
End Sub
----------------------------------------------------------------------
なお、VBAではインデント指定していますが、ここではベタ打ちのようになってしまいます。ご容赦下さい。よろしくお願いします。

回答No.6

real beatin（@realbeatin） · ベストアンサー

こんにちは。

添付画像は、ご提示のマクロの実行結果を、
スクロール先ごと色分けして、実行前のセル範囲を
塗り潰したものです。
黒くなっている部分は、スクロールを実行しない範囲。
白太罫線枠で囲ってあるのは、
ご提示のマクロで、行・列の両方ともに判別に掛かっている部分で、
それぞれ罫線枠の左上がスクロール先です。
罫線枠で囲われていない部分での挙動については、
そういう動作仕様もあると思いますし、
罫線枠の内側に限定したい場合もあると思ったので、
２例、順番に挙げておきます。

自分の頭で規則性を整理できないことって、
誰にでも（勿論私も）あることですから、
うまく言葉で説明できなかったりしても、
　（今回のように努めて整理されたマクロが
　　実際に動く形で提示されているのでしたら）
OKWAVEでは、まったく気にすることはないと私は思います。
日頃からの読み書きに慣れる頻度によって
感じ方は当然違いますから、厳しく求められる場面もあるでしょうけれど。
私自身が混乱して困った時には、添付画像のようなもので、
頭を整理する為のひと手間を掛けたり、よくしますね。
今回は実物ファイルのレイアウトもイメージできたので、
添付画像の手間も実は必要なかったのですが、
そちらで少しでも解り易なればなぁ、と。

以下、変数を使って、
オブジェクトアクセスを最小限にしつつ
条件分岐を整理してみました。
ついでに、With ステートメント の内側は
なるべく（mustでは全然ないです）、スッキリしている方が
個人的には好きだったりします。

' ' //　ご提示のマクロとまったく同じ挙動のもの
Sub Re9322475W0()
Dim nTgR As Long　'　スクロール先：Row
Dim nTgC As Long　'　スクロール先：Column

　　Select Case ActiveCell.Row　'　行
　　Case 4 To 29: nTgR = 4
　　Case 37 To 62: nTgR = 37
　　End Select

　　Select Case ActiveCell.Column　'　列
'　　Case 6 To 36: nTgC = 6　'　←不要（∵Elseで適用できるので）
　　Case 44 To 50: nTgC = 44
　　Case 55 To 61: nTgC = 55
　　Case 66 To 79: nTgC = 66
　　Case Else: nTgC = 6
　　End Select

　　If nTgR > 0 Then　'　行（4:29,37:63）が指定されている場合のみ
　　　　With ActiveWindow　'　スクロール実行
　　　　　　.ScrollRow = nTgR
　　　　　　.ScrollColumn = nTgC
　　　　End With
　　End If

End Sub
' ' //

' ' //　添付画像の白太罫線枠の内側に限定したもの
Sub Re9322475W1()
Dim nTgR As Long　'　スクロール先：Row
Dim nTgC As Long　'　スクロール先：Column

　　Select Case ActiveCell.Row　'　行
　　Case 4 To 29: nTgR = 4
　　Case 37 To 62: nTgR = 37
　　End Select

　　Select Case ActiveCell.Column　'　列
　　Case 6 To 36: nTgC = 6
　　Case 44 To 50: nTgC = 44
　　Case 55 To 61: nTgC = 55
　　Case 66 To 79: nTgC = 66
　　End Select

　　If nTgR > 0 And nTgC > 0 Then　'　行（4:29,37:63）と列が指定されている場合のみ
　　　　With ActiveWindow　'　スクロール実行
　　　　　　.ScrollRow = nTgR
　　　　　　.ScrollColumn = nTgC
　　　　End With
　　End If

End Sub
' ' //

今回は"条件分岐と書き方"がテーマだと思いますが、
一応、他の可能性として、
許されるなら、シート上に対応表を作表しておいて、
ExcelのMATCH関数あたりを組み合わせれば、
ずっと簡素な形にできる、というやり口も一応、あります。

因みに、インデントなくっても問題ないですけれど、興味お持ちなら。
インデントを維持したままアップする方法として、簡単なのは、
一旦テキストエディタ（メモ帳でもOK）にコピペして、
そちらの置換機能で半角スペース２つを全角スペースに置換する
とか、です。
Excelでも出来なくはないですけれど、
状況によって思わぬ結果になることもあります。
現在のＶＢＡのエディタ（ＶＢＥ）では、ペーストした時に
行頭の全角スペースを半角スペース２つに戻してくれます。
（ＶＢＡ以外のソースでは、あまり奨められませんけど。）

以上、ご参考まで。

お礼

結局のところ、以下のようにさせて頂きました。

Sub seikatsu()
Dim SR As Integer, SC As Integer

Select Case ActiveCell.Column
Case 1 To 40
SC = 6
Case 41 To 51
SC = 44
Case 52 To 62
SC = 55
Case 63 To 79
SC = 66
End Select

Select Case ActiveCell.Row
Case 1 To 33
SR = 4
Case 34 To 62
SR = 37
End Select

With ActiveWindow
.ScrollColumn = SC
.ScrollRow = SR
End With
End Sub

非常に視認性と可読性と判読性が高くなり、おまけにだいぶ短く出来、その点でも見易くなりました。お答え頂いた皆さん、ありがとうございました。

回答No.5

imogasi

これは何がしたいプログラムですか。
それぐらいは、他人を煩わせて、質問するのだから、書いておくべきだろう。
画面、ウインドウの処理ばかりで、セルのデータの処理は載ってないが。
普通はこういうケースに出くわすことはあまりないだろうと思った。
ーー
まずネストした表現にできないか考えるとか。
ーー
行と列のそれぞれのセル範囲の区分けがあるようだが、こういう四角のセル範囲の処理ごとに、多少処理が違うものは、こうでも書かないとしようがないかな。
ーー
下記を考えてみることを提案する。配列の活用というのかな。
長方形的なセル範囲について処理を変えるなら
Sub test02()
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")　’Ｓｈｅｅｔ２の同番地セルにテスト的にコピー用
'--
Rng = Array("A1:B6", "C1:D6", "E1:G6") '3つの範囲の例、１０ぐらい書けるだろう。行の数字、は不揃いでも構わない。Ｈ３：Ｊ８のように。
Dim cl As Range
'---
For i = 0 To UBound(Rng)
MsgBox Rng(i)
Worksheets("Sheet1").Activate
sh1.Range(Rng(i)).Select
MsgBox "A"
'--
For Each cl In sh1.Range(Rng(i))
r = cl.Row: c = cl.Column
sh2.Cells(r, c) = cl.Value
Next
Next i
End Sub
のように、セル範囲を文字列的に配列で定義し、
ScrollRow = ｘｘ
.ScrollColumn ＝ｙｙ
は、この２つの引数で受け渡し、サブルーチン（モジュール）化してはどうかな。
又はこれも上記コードで「Ｒａｎｇｅを定義した配列」と、順番を合わせて配列に定義すれば、
ScrollRow の配列１つ、ScrollColumn の配列を１つ増やせば、すっきりする。

回答No.4

Nouble

Select Case ActiveCell.Row
Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 6
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 6
End Select

此を
別サブルーティンコールに、すると

　　If ActiveCell.Column > 5 And ActiveCell.Column < 37 Then
　　　　call　○○(ParamArray(…
ElseIf ActiveCell.Column > 43 And ActiveCell.Column < 51 Then
　　　　call　○○(ParamArray(…
ElseIf ActiveCell.Column > 54 And ActiveCell.Column < 62 Then
　　　　call　○○(ParamArray(…
ElseIf ActiveCell.Column > 65 And ActiveCell.Column < 80 Then
　　　　call　○○(ParamArray(…
Else
End If
と、
とても
丹頂に、なります

カラム値群を
Arrayに、入れて
ループに、される事を
お勧めします

又は
Option　Base　1
type　ケース形式
　　ケース(2)　　As　Long
　　セレクト行　As　Long
　　セレクト列　As　Long
End　type

type　ループデーター形式
　　カラム上　　As　Long
　　カラム下　　As　Long
　　ケース(2)　　As　ケース形式
End　type

Sub　○○(…
Dim　ループデーター(4)　As　ループデーター形式

と、して

Case 4 To 29
.ScrollRow = 4
.ScrollColumn = 6
Case 37 To 62
.ScrollRow = 37
.ScrollColumn = 6
も
Case i To j
.ScrollRow = ×
.ScrollColumn = y
の、ループに
して
Ifも、ループに
して
値セット、して
渡せば、良い
と、思いますよ

回答No.3

f272

Sub seikatsu()
If ActiveCell.Column > 5 And ActiveCell.Column < 37 Then
sc = 6
ElseIf ActiveCell.Column > 43 And ActiveCell.Column < 51 Then
sc = 44
ElseIf ActiveCell.Column > 54 And ActiveCell.Column < 62 Then
sc = 55
ElseIf ActiveCell.Column > 65 And ActiveCell.Column < 80 Then
sc = 66
Else
sc = 6
End If

With ActiveWindow
If ActiveCell.Row >= 4 And ActiveCell.Row <= 29 Then
.ScrollRow = 4
.ScrollColumn = sc
ElseIf ActiveCell.Row >= 37 And ActiveCell.Row <= 62 Then
.ScrollRow = 37
.ScrollColumn = sc
Else
'???
End If
End With
End Sub

回答No.2

mshr1962

単純にActiveCell.RowとActiveCell.Columnの組み合わせ判定でなしに
別途Select文かIf文でいいのでは？

Sub seikatsu()
With ActiveWindow

Select Case ActiveCell.Row
Case 37 To 62
.ScrollRow = 37
Case Else
.ScrollRow = 4
End Select

Select Case ActiveCell.Column
Case 44 to 50
.ScrollColumn = 44
Case 55 to 61
.ScrollColumn = 55
Case 66 to 79
.ScrollColumn = 66
Case Else
.ScrollColumn = 6
End Select
End With
End Sub

回答No.1

hawa254

今後、このマクロの改版や流用がないなら、そのままでいいと思います。
改版や流用があるなら、少しわかりずらいコーディングになっているので、別Procにした方が、保守性が良くなると思います。

お礼

>少しわかりずらいコーディングになっている
ですよね。。。解り難いですよね？他の回答も参考に解り易くなるよう変えてみます。ありがとうございます。