Excel VBA質問箱 IV

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

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


9464 / 13646 ツリー ←次へ | 前へ→

【27135】ある条件を満たしたとき、自動的に日付を表示させるには? KK 05/7/29(金) 16:09 質問[未読]
【27138】Re:ある条件を満たしたとき、自動的に日付... でれすけ 05/7/29(金) 16:50 発言[未読]
【27177】Re:ある条件を満たしたとき、自動的に日付... KK 05/8/1(月) 10:02 質問[未読]
【27181】Re:ある条件を満たしたとき、自動的に日付... でれすけ 05/8/1(月) 11:28 発言[未読]
【27192】Re:ある条件を満たしたとき、自動的に日付... KK 05/8/1(月) 14:56 お礼[未読]

【27135】ある条件を満たしたとき、自動的に日付を...
質問  KK  - 05/7/29(金) 16:09 -

引用なし
パスワード
    A列〜I列 :品質チェック用項目
 J列 :四半期毎の結果(2004-1期)
 K列 :結果(店舗A用)
 L列 :自動日付入力列
 M列 :商品A
 N列 :商品B
 O列 :商品C
 P列 :商品D
 Q列 :結果(店舗B用)
 R列 :自動日付入力列
 S列 :商品A
 T列 :商品B
 U列 :商品C
 V列 :商品D
 W列 :結果(店舗C用)
 X列 :自動日付入力列
 Y列 :商品A
 Z列 :商品B
 AA列 :商品C
 AB列 :商品D
 AC列 :四半期毎の結果(2004-2期)
 AD列 :結果(店舗A用)
 AE列 :自動日付入力列
 AF列 :商品A
 AG列 :商品B
 AH列 :商品C
 AI列 :商品D
 (略)

以上のような一覧があり、品質管理のチェックシートになっております。
指定の列(自動日付入力列)に「日付の自動入力」が出来るようにしたいです。

<仕様>
1.上記一覧は1行目に入力されている文字列です。(文字列は変更する可能性有り)
2.M列〜P列、S列〜V列、Y列〜AB列、AF列〜AI列
 は「リストから数値を選択する」設定にしています。
3.K列、Q列、W列、AD列
 は、いずれかの商品列に数値が入ったときに、「○」「△」「×」などが入るように数式が入っています。
4.J列、AC列
 は、各店舗の結果に対する判定式が入っています。
5.商品数は4個とは限りません。
6.同じシート内で、商品数は4個であったり、5個であったりする場合もあります。


以上のような仕様を満たしていることが条件で
商品A〜Dのいずれかに入力(リストから選択)があったとき、自動日付入力列に入力があった日付を表示するようにしたいです。
ただし、商品A〜Dまで一旦入力しても、商品A〜Dを空欄にしたときには、日付は空欄にしたいです。

・入力するときは、コピペをする
・削除するときは、複数選択して削除する
という操作をすることも考慮したコードをご教授いただけますでしょうか。

【27138】Re:ある条件を満たしたとき、自動的に日...
発言  でれすけ  - 05/7/29(金) 16:50 -

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

>コードをご教授
っていうのは、そのまま動くコードをここに書けということでしょうか。


Private Sub Worksheet_Change(ByVal Target As Range)
Dim aRow As Range, Rng As Range

Set Rng = Range("AF2:AI20000")
Set Target = Intersect(Target, Rng, Me.UsedRange)
If Target Is Nothing Then Exit Sub
 
  With Application
   .EnableEvents = False
   .ScreenUpdating = False
   .Interactive = False
  End With
 
  On Error GoTo Err_Handler
   For Each aRow In Target.EntireRow.Rows
     If WorksheetFunction.CountA(aRow.Range("AF1:AI1")) > 0 Then
       aRow.Range("AE1").Value = Date
     Else
       aRow.Range("AE1").ClearContents
     End If
   Next
  On Error GoTo 0

Terminate:
  With Application
   .EnableEvents = True
   .ScreenUpdating = True
   .Interactive = True
  End With
 
Exit Sub
'---------------------------------
Err_Handler:
  'エラーハンドラ
Resume Terminate

End Sub

【27177】Re:ある条件を満たしたとき、自動的に日...
質問  KK  - 05/8/1(月) 10:02 -

引用なし
パスワード
   でれすけさん、回答ありがとうございました。

返信が送れまして申し訳ありません。
>>コードをご教授
>っていうのは、そのまま動くコードをここに書けということでしょうか。
すみません。
次のコードを書くのを忘れていました・・・

以下のようなコードを書いてみたのですが、
 ・入力するときは、コピペをする
 ・削除するときは、複数選択して削除する
に対応できませんでした。

以上の2つの動作を含むにはどのようにすればよろしいのでしょうか。

====================================================================================================
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim i As Integer
  Dim j As Integer
  j = 0
  With Target
    If .Cells.Count > 1 Then Exit Sub '変更されたセルは1個に限定
    If .Column <= 10 Then Exit Sub '変更されたセルはK列以降に限定
    For i = 1 To .Column
     If Left(Cells(1, i), 7) = "四半期毎の結果" Then
      j = j + 1
     End If
    Next
    Select Case (.Column - 9 - j) Mod 6 '編集されたセルはK列から6列サイクルで3〜6列に限定します。
     Case 3, 4, 5, 0
     Case Else
     Exit Sub
    End Select
       
    If .Offset(, 0 - (.Column - 10 - j) Mod 6).Value <> "" Then 'サイクルの1列目が空白への変更でない場合に限定
      .Offset(, 1 - (.Column - 10 - j) Mod 6).Value = Format(Date, "yyyy/mm/dd")    'サイクルの2列目に当日日付を記入
     Else
      .Offset(, 1 - (.Column - 10 - j) Mod 6).Value = ""   'サイクルの1列目が空白になった場合、日付を消去
    End If
  End With
End Sub
====================================================================================================

【27181】Re:ある条件を満たしたとき、自動的に日...
発言  でれすけ  - 05/8/1(月) 11:28 -

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

>以下のようなコードを書いてみたのですが、
> ・入力するときは、コピペをする
> ・削除するときは、複数選択して削除する
>に対応できませんでした。

簡単にかけば、変更されたセル一つ一つに対して繰り返し処理を行う
ことになります。

ただし、大量のセルが変更されたときにストレスを感じない程度の
スピードを確保することは相当に難しく思われます。

また、ユーザにシートのレイアウトが変更されたときに対処するのが難しいです。
シートを保護するなどして、変更されるセルを限定するなどの対処をすべきです。

そもそも、シートのレイアウトが複雑過ぎるように感じます。
商品が4個だったり5個だったりというのは、規則性が崩れて対応が面倒になります。
レイアウト上は最大値の5個に固定するなどすれば、多少VBAのコードも
簡単に出来るかもしれません。

以上のことから、やってできないことはないでしょうが、
出来るまでには結構な時間と工数がかかるでしょうし、
完成したとして実用に耐えるものになるかどうかかなり疑問です
ということを予め申し上げておきます。

まずは、がんばってみてください。

【27192】Re:ある条件を満たしたとき、自動的に日...
お礼  KK  - 05/8/1(月) 14:56 -

引用なし
パスワード
   でれすけさん、回答ありがとうございました。

もう少しシートをすっきりさせてから考えようと思います。

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