dポイントプレゼントキャンペーン実施中!

現在、伝票を2回入力することにより、入力チェックするエクセルBOOKがあります。
そのエクセルBOOKは、セルに埋め込まれたIF関数でチェックしていたため、
ファイル容量が大きくなることや、
時々異常終了するようになったため、vbaで同じ機能を作成しようと思いました。

なお、条件付き書式でも同じ事が出来そうですが、
VBAなら、セルの移動や貼り付けなど、シートやセルに対してどのような事をされても
チェック機能は損なわれないと思って、条件付き書式を使用しませんでした。

シートへは、入力1(B:E)入力2(J:M)の4つの項目を2回入力し、
それぞれ同じ値かをチェックします。
対応するセルの値が違う場合、両方のセルの色を水色にします。

変数名の付け方がわかりやすいかどうか、
select caseの指定が、直接していしている所が気になります。

もっと短く、簡潔に、そして分かりやすいコードになるような気がして、
質問してみようと思いました。
アドバイスをおねがいます。



Option Explicit

Const normalColor As Integer = xlNone
Const warningColor As Integer = 28 '水色

Const rangeScope As String = "B:E,J:M"


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As range)

Dim ranges As range

Set ranges = Intersect(Target, range(rangeScope))
If (ranges Is Nothing) Then Exit Sub

Dim rng As range

If ranges.CountLarge > 30000 Then
MsgBox "数が多すぎてチェック出来ません"
Else
For Each rng In ranges
Select Case rng.Column
Case 2 To 5 'B:E 左側
Call compare(rng, rng.Offset(0, 8))
Case 10 To 13 'J:M 右側
Call compare(rng.Offset(0, -8), rng)
End Select
Next rng
End If

End Sub

Private Sub compare(LeftRenge As range, RightRenge As range)
Dim color As Integer

'同じor右側未入力
If LeftRenge.Value = RightRenge.Value _
Or IsEmpty(RightRenge.Value) Then
color = normalColor
Else
color = warningColor
End If
LeftRenge.Interior.colorindex = color
RightRenge.Interior.colorindex = color

End Sub

A 回答 (2件)

実際に動かしてはいませんが、説明とコードを見て思ったことを挙げます。



きれいなコードだと思います。
コードが間違っているわけではないので、質問者さんの判断にお任せします。

1.左側未入力のチェックが無い。
  左側未入力が見つかるタイミングに違いがあります。
  このコードでは、左側未入力と右側入力有でwarningColorになります。
  左側未入力だけでwarningColorにするか

2.Exit Subの有無
  If (ranges Is Nothing) Then Exit Sub で「Exit Sub」を使うなら、
  -----
  If ranges.CountLarge > 30000 Then
  MsgBox "数が多すぎてチェック出来ません"
  Exit Sub
  Dim rng As range
  -----
  の方が、作り手の考えが一貫しているように見えます。

3.Case 10 To 13 'J:M 右側 は必要か?
  Case 2 To 5 'B:E 左側
  Call compare(rng, rng.Offset(0, 8))
  と
  Case 10 To 13 'J:M 右側
  Call compare(rng.Offset(0, -8), rng)
  は重複しているように見えます。

  rangesにB列はなくJ列はある、という場合がありますか?

4.変数名等の1文字目の小文字大文字
  他の変数名・関数名に倣い、1文字目を小文字に統一したほうが良いと思います。
  LeftRenge → leftRenge
  RightRenge → rightRenge
  Workbook_SheetChange → workbook_SheetChange

  さらにスネーク型(_を入れる)の有無も統一したいですね。
    • good
    • 0
この回答へのお礼

ご指摘ありがとうございます。
1.左側未入力のチェックが無い。については、
最初に左側を入力し、全伝票を打ち終えたら、右側を入力するという運用で
誤入力をチェックする仕様なので、
あえて、左側入力時はチェックを入れていません。

その他については、参考にさせていただきました。
ありがとうございます。

お礼日時:2018/05/15 17:28

まだ、この質問が開けてあるようですが、


>変数名の付け方がわかりやすいかどうか、
>select caseの指定が、直接していしている所が気になります。
>もっと短く、簡潔に、そして分かりやすいコードになるような気がして、

何か、現状で可動しているものについて、さらに上を望んで掲示板に質問を出しても成功する可能性は低いと思います。まず、完動しているものに、質問者さんにとって付けられてるような気持ちにならないかと思います。欲を言えばきりがありません。

ただ、よほどのことがない限りは、イベント・ドリブン型は、サブルーチンを作らないほうがよいです。変数は、慣れてくればくるほど、短めにしてしまいます。

もっとも、このコードの疑問は、Workbook_SheetChangeにしていることです。
少し違う点は、右側にしろ左側にしろ、両方のデータがない限りは、色は付きません。

私なりに考えた結果は、このようなシートに対するイベント・ドリブン型のWorksheet_Change のマクロです。

'//
Private Sub Worksheet_Change(ByVal Target As Range)
Dim col As Long
Dim opCol As Long
Dim rw As Long
Dim tmp As Long
If Target.Count > 1 Then Exit Sub
col = Target.Column: rw = Target.Row

If Not (col > 1 And col < 6) And Not (col > 9 And col < 14) Then Exit Sub

If (col > 1 And col < 6) Then opCol = col + 8
If (col > 9 And col < 14) Then opCol = col - 8
If opCol < col Then tmp = opCol: opCol = col: col = tmp

If Cells(rw, col).Value <> "" And Cells(rw, opCol).Value <> "" Then
 If Cells(rw, col).Value = Cells(rw, opCol).Value Then
  Cells(rw, col).Interior.ColorIndex = xlColorIndexNone
  Cells(rw, opCol).Interior.ColorIndex = xlColorIndexNone
 Else
  Cells(rw, col).Interior.ColorIndex = 28
  Cells(rw, opCol).Interior.ColorIndex = 28
 End If
Else
 Cells(col, rw).Interior.ColorIndex = xlColorIndexNone
 Cells(opCol, rw).Interior.ColorIndex = xlColorIndexNone
End If
End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!