Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


35360 / 76732 ←次へ | 前へ→

【46572】Re:[46222]の追加質問 セルの入力方法
発言  ichinose  - 07/2/6(火) 23:09 -

引用なし
パスワード
   こんばんは。

これは、ちょっと難しいですねえ!!


>毎日、C列の日付とともにD列に3桁の数値を入力します。
>その数値とは165 〜975の数値で、すべて存在する訳ではなく、抜けている数値もあります。(たとえば、167、193などは抜けています)
>D列の入力方法はC列のように昇順ではなく、ランダム的な入力方法です。
>
>しかし、下記のような入力方法のルールがあります。
>*「同じ日付(C列)に対応する同じ数値(D列)は、続けて入力しなければいけ  ない」
> 下記の例だと、D10の177が入力ミスです。
>
>[追加コード]
>下記のD10の177のように、このルールに反してD列に入力した場合、「入力ミス」と表示したいのです。
>      A    B     C      D列
> 1    1        2007/1/31    176
> 2    2        2007/1/31    187
> 3    3         2007/1/31    177
> 4    4         2007/2/1     176
> 5    5         2007/2/2     188
> 6    6         2007/2/3     177
> 7    7        2007/2/3     177
> 8    8        2007/2/3     975
> 9    9         2007/2/3     170
>10    10        2007/2/3     177 ← 入力ミス

数式使うと簡単そうですが 今回も敢えて使いません!!


まず、上記のシートがあるシートモジュールに
(標準モジュールではないですよ!!)
'================================================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range
  Dim crng As Range
  Dim drng As Range
  Dim rw As Long
  Dim dd As Date
  Dim retcode As Boolean
  Set rng = Application.Intersect(Target, Range("d1:d65536"))
  If Not rng Is Nothing Then
    For Each crng In rng
     If IsDate(crng.Offset(0, -1).Value) Then
       retcode = True
       dd = crng.Offset(0, -1).Value
       rw = 1
       Call init_ctn
       Do Until Cells(rw, 3).Value = ""
        If Cells(rw, 3).Value = dd Then
          retcode = chk_ctn(Cells(rw, 4).Value, rw)
          If retcode = False Then
           Cells(rw, 4).Select
           MsgBox "入力ミス"
           Exit Do
           End If
          End If
        rw = rw + 1
        Loop
       Call term_ctn
       If retcode = False Then Exit For
       End If
     Next
    End If
End Sub


標準モジュールに
数字の連続性のチェックを行うプロシジャー群

'=========================================================
Option Explicit
Dim ctnvalue() As Variant
Dim ctnrow() As Long
Dim ctnidx As Long
'==========================================================
Sub init_ctn()
'連続性をチェックする内部データの初期化
  Erase ctnvalue
  Erase ctnrow
  ctnidx = 1
End Sub
'==========================================================
Function chk_ctn(ByVal chkvalue As Variant, _
         ByVal chkrow As Long) As Boolean
'指定されたデータが連続しているか否かのチェック
'chkvalue 値 chkrow 値の位置
'chk_ctn True 連続している False 連続していない
  Dim g0 As Variant
  On Error Resume Next
  chk_ctn = False
  g0 = Application.Match(chkvalue, ctnvalue(), 0)
  If IsError(g0) Or Err.Number <> 0 Then
    ReDim Preserve ctnvalue(1 To ctnidx)
    ReDim Preserve ctnrow(1 To ctnidx)
    ctnvalue(ctnidx) = chkvalue
    ctnrow(ctnidx) = chkrow
    ctnidx = ctnidx + 1
    chk_ctn = True
  Else
    If chkrow = ctnrow(g0) + 1 Then
     ctnrow(g0) = chkrow
     chk_ctn = True
     End If
    End If
End Function
'==========================================================
Sub term_ctn()
'連続性チェックの終了処理
  On Error Resume Next
  Erase ctnvalue()
  Erase ctnrow()
  ctnidx = 0
End Sub


これでD列の数値入力してみてください
数字が連続していなければ、エラーメッセージが表示されます。

細かいコメントや説明をしませんから、じっくり解読してみてください。

結構大変ですよ!!
1 hits

【46559】[46222]の追加質問 セルの入力方法 さや 07/2/6(火) 20:27 質問
【46560】Re:[46222]の追加質問 セルの入力方法 かみちゃん 07/2/6(火) 20:40 発言
【46562】Re:[46222]の追加質問 セルの入力方法 さや 07/2/6(火) 21:02 質問
【46563】Re:[46222]の追加質問 セルの入力方法 かみちゃん 07/2/6(火) 21:09 発言
【46568】Re:[46222]の追加質問 セルの入力方法 さや 07/2/6(火) 21:28 質問
【46569】Re:[46222]の追加質問 セルの入力方法 かみちゃん 07/2/6(火) 21:58 発言
【46570】Re:[46222]の追加質問 セルの入力方法 さや 07/2/6(火) 22:25 質問
【46571】Re:[46222]の追加質問 セルの入力方法 かみちゃん 07/2/6(火) 22:45 発言
【46573】Re:[46222]の追加質問 セルの入力方法 さや 07/2/6(火) 23:13 発言
【46572】Re:[46222]の追加質問 セルの入力方法 ichinose 07/2/6(火) 23:09 発言
【46575】Re:[46222]の追加質問 セルの入力方法 さや 07/2/6(火) 23:55 お礼

35360 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free