Excel VBA質問箱 IV

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

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


4285 / 76734 ←次へ | 前へ→

【78073】Re:イベント処理について
質問  かず  - 16/3/27(日) 14:15 -

引用なし
パスワード
   ▼かず さん:
>▼β さん:

質問を再度整理しました。
コピーしたセルの挿入時、挿入行の行番号
を把握するための方法について教えてください。

1.業務要件
(1)建設プロジェク(=案件と呼ぶ。)の案件名、担当社、売上、利益
 などを1行にまとめて月次でメンテしています

(2)大元のマスタリストがあり、それを月に一回、10人の担当者に配布。
担当者は自分の担当案件の追加や、案件の売上や利益の変化を、配布
された表に記載して返信。

(3)各担当から返信されたリストを大元のマスタに反映させています

2.担当者が案件情報をリストに反映する際の記載ルール

▼(更新):
リストの各行に対し変更ががある場合、行の1列目に▼印をつける。

 削除は行削除ではなく、案件の進捗を示すセルを用意して、
 失注として表す。リストの行の削除は考慮不要。

★(挿入):
リストに対し、案件=行を追加する場合1列目に★印をつけて、行
ごと追加する

2.ワークシートのイメージ

(1) 最初にマスタ側リスト作成時、リスト右端余白で今は使われていない
 部分に以下の作業列を追加

  列    作業列1  作業列2 作業列3

  番号   日時時刻   シーケンスNo 枝番
  A/1 (略) BL/64     BM/65  BN/66  現時点の枝番号の計算式
行  --------------------------------------------------------------------------------
10 ␣ (略) 2016/3/26/ 18:23 1   1  =COUNTIF($BM$10:$BM709,BM10) 
11 ␣  略
12 ␣  略
13 ★ (単純な空行の挿入) ・␣・  1  =COUNTIF($BM$11:$BM709,BM11)   
14 ␣
15 ・・ ・2016/3/26/ 18:23・・6・・1  =COUNTIF($BM$15:$BM15,BM15) (A)
16 ★・(15行目をコピー挿入)  6・・2  =COUNTIF($BM$16:$BM16,BM16) (A)
17 ␣  略
18 ␣  略
19 ★・(20行目をコピー挿入)・ 9・・2  =COUNTIF($BM$18:$BM709,BM18) (B)
20 ␣・・・・・・・・・・・・ 9・・2  =COUNTIF($BM$19:$BM709,BM19) (B) 
709 ・・・・・・・・・・・・・697・ 1  =COUNTIF($BM$10:$BM709,BM709)

【説明】
 行の挿入には、単純な空行の追加とコピーした行の挿入の2種類がある。
 どちらの場合も、井川はるき著 VBA裏ワザ大辞典Sample31_1のコードを
 参考にして行が挿入されたことは添付のコードで検知可能。

 業務要件から1列目に★印をつけたいが、コピー元はそのままで
 コピー先にだけ★印をつけたい。

 ⇒ 単純空行の挿入の場合は、本来はシーケンスNoとしているBM列に空白が
できるのでそこをFind文で探して 行番号を取得可能。
   
 ・ただしコピーして挿入の場合は、BM列の値は同じ値の行が複数できてしまう。
 BN列に枝番号や重複有無を示す計算式を入れる方法、(上記(A)(B)あるがいずれも
 うまくいかない)では重複していることはわかるがどの行が挿入されたかわからない。

 ・コピーして挿入なので タイムスタンプではコピー前とコピー後の区別がつかない
 
【質問事項】
 Q1 コピーした行を挿入のイベントが発生した場合に、イベント処理の中で
  どの行が挿入されたか枝番やタイムスタンプか、他の方法で特定する方法
  をご存知の方は教えてください。

 Q2 上記のイベント処理では、ブックを開いて閉じるまでのイベントをタイマ
  監視しているが何かの理由でイベントの監視ができなくなった場合、
  イベント処理をあきらめて手動でワークシートを記載してもらえればよい
  ようにするにはどうしたらよいでしょうか

  既定のイベントでは Application.EnableEvents = False を発行すれば
  イベントが発生しなくなるので、自作イベントでもそのようにするにはど
  すればいいいでしょうか?
 
  イベント監視処理は中止します。修正が終了したら1列目に▼や★を書くの
  を忘れず記入してくださいとメッセージがだせれば十分です。
 
3.イベントプロシジャを使うコード
  井川はるきさんおサンプルコードを一部改変して作成しました。
  私には少し難しい方法のようです

' 井川はるき さんのサンプルコード
' ★印の行は 投稿者 かずが改変した部分
’***************************************
' サンプル解説の?@ クラスモジュール clsRowsInsertEvent
' ***************************************
Public Event RowsInsert(Cancel As Boolean, InsRow As Long) ’★ InsRowを追加 by かず

Public Sub CheckRowsInsert(ByVal mySht As Worksheet)
Static myRow As Range
Dim myInsRow As Long     '★ 行を挿入した行番号を格納するための変数
Dim myCancel As Boolean
Dim w_FndRng As Range

Const TopRow As Integer = 29 '★ 作業列2の最初の行番号の
Const SeqCol As Integer = 65 '★ 作業列2の列番号
Const EdaNum As Integer = 66 '★ 作業列2 枝番を格納するための行
Dim i As Long         '★ 制御変数
  
If mySht Is Nothing Then Exit Sub

With mySht
 If Not myRow Is Nothing Then

  On Error Resume Next
  myInsRow = myRow.Row

  If Err().Number <> 0 Then 

  ’★単純な行の挿入の場合、SeqCol列の空白を探す
  Set w_FndRng = Range(Cells(TopRow, SeqCol), Cells(Rows.Count, SeqCol).End(xlUp)).Find("", , xlValues, xlWhole, xlByRows, xlNext) '★
  
  If Not w_FndRng Is Nothing Then ’★
    ' ★単純に行挿入された場合 SeqCol列は""空白のセルがある
    myInsRow = w_FndRng.Row   ' ★
  Else
    '★ コピーして挿入の場合、作業列2には元の行と同じ値が入る 
    i = TopRow            '★
    Do While (i < Rows.Count)    '★
      If Cells(i, EdaNum) > 1 Then '★
        myInsRow = i       '★
        Exit Do          '★
      End If            '★
      i = i + 1           '★
    Loop               '★
  End If                '★
        
  RaiseEvent RowsInsert(myCancel, myInsRow)
  If myCancel Then
     Application.Undo
  End If
 End If
 End If
 Set myRow = .Rows(.Rows.Count)
End With
End Sub

'***********************************************************
' ?A 標準モジュール
'***********************************************************
Sub TimerProc(ByVal Hwnd As Long, ByVal uMsg As Long _
  , ByVal idEvent As Long, ByVal dwTime As Long)
  On Error Resume Next
  ThisWorkbook.RowsInsertEventClass.CheckRowsInsert Sheet3 ’★引数Sheet3をかずの環境にあわせて設定
End Sub

’***************************************
' ?B ThisWorkbook
' ***************************************

Private Declare Function SetTimer Lib "user32" ( _
  ByVal Hwnd As Long, ByVal nIDEvent As Long _
  , ByVal uElapse As Long, ByVal lpTimerFunc As Long) _
  As Long
Private Declare Sub KillTimer Lib "user32" ( _
  ByVal Hwnd As Long, ByVal nIDEvent As Long)

Private WithEvents myRowsInsertEventClass As clsRowsInsertEvent
Private myTimerId As Long

Private Sub myRowsInsertEventClass_RowsInsert(Cancel As Boolean, myInsRow As Long)
  '
 '★ 作業列1 時刻取得して タイムスタンプをとる(予定)
 '★ 作業列2 シーケンシャル番号を格納する(予定)
  MsgBox myInsRow & "行に挿入されました" ’★ 現状 挿入行を確認するため MsgBoxを出力
  
  Cancel = MsgBox("行が挿入されました。" & vbCrLf _
    & "キャンセルしますか?", vbInformation Or vbYesNo) = vbYes
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim myRes As VbMsgBoxResult
  If Not Saved Then
    myRes = MsgBox("'" & Name & "' への変更を保存しますか?" _
      , vbExclamation Or vbYesNoCancel)
    If myRes = vbYes Then
      Save
    ElseIf myRes = vbNo Then
      Saved = True
    Else
      Cancel = True
      Exit Sub
    End If
  End If
  KillTimer 0&, myTimerId
  Set myRowsInsertEventClass = Nothing
End Sub

Private Sub Workbook_Open()
  myTimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub

Public Property Get RowsInsertEventClass() As clsRowsInsertEvent
  If myRowsInsertEventClass Is Nothing Then
    Set myRowsInsertEventClass = New clsRowsInsertEvent
  End If
  Set RowsInsertEventClass = myRowsInsertEventClass
End Property
12 hits

【78064】イベント処理について かず 16/3/26(土) 11:09 質問[未読]
【78065】Re:イベント処理について かず 16/3/26(土) 11:31 回答[未読]
【78067】Re:イベント処理について β 16/3/26(土) 12:52 発言[未読]
【78072】Re:イベント処理について かず 16/3/27(日) 2:25 回答[未読]
【78073】Re:イベント処理について かず 16/3/27(日) 14:15 質問[未読]
【78074】Re:イベント処理について かず 16/3/27(日) 14:16 発言[未読]

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