| |
ワークシートのチェンジイベントで、
マクロ処理をさせているのですが、
自分のパソコンではうまく動作するのですが、
違うパソコンによっては、イベントが発生しなかったりします
原因がわかりません
なにか理由があるとすればなんなんでしょうか？
現在は下記の記述となってます
どうかご教授お願いします
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------
'K列,O列の値が変更されたときに発生するイベント
'-----------------------------------------
Dim LastR As Long
Dim MyTarget As Range, MyTarget2 As Range
Dim 指定Day As Long, 基準Day As Long
LastR = Range("A" & Rows.Count).End(xlUp).Row
Set MyTarget = Range("K2").Resize(LastR - 1) 'K列範囲指定
Set MyTarget2 = Range("O2").Resize(LastR - 1) 'O列範囲指定
If chk(Target, MyTarget) = True Then
Dim RngLookUp As Range, C As Range
Dim M As Variant
With Sheets("MDay")
Set RngLookUp = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each C In MyTarget
C(1, 2).ClearContents
C(1, 3).ClearContents
M = Application.Match(C.Value2, RngLookUp, 0)
If IsNumeric(M) Then
指定Day = RngLookUp.Item(M, 2).Value
M = Application.Match(C.Offset(, -4).Value2, RngLookUp, 0)
If IsNumeric(M) Then
基準Day = RngLookUp.Item(M, 2).Value
C(1, 2).Value = 指定Day - 基準Day
C(1, 3).Value = 指定Day - 基準Day + 5
End If
End If
Next
ElseIf chk2(Target, MyTarget2) = True Then
Dim RngLookUp1 As Range, RngLookUp2 As Range
Dim MyRng As Range, Find_Rng As Range
Dim MyDate, MyDate2
Dim M1, M2
With Sheets("MDay")
Set RngLookUp1 = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Set RngLookUp2 = .Range("B2", .Cells(.Rows.Count, 1).End(xlUp))
End With
'
For Each MyRng In MyTarget2
Application.EnableEvents = False
MyRng(1, 2).ClearContents
MyRng(1, 3).ClearContents
Application.EnableEvents = True
If MyRng.Value <> "" Then
Set Find_Rng = RngLookUp1.Find(what:=CDate(Cells(MyRng.Row, "G")))
If Not Find_Rng Is Nothing Then
MyDate = Find_Rng.Offset(, 1)
MyDate = MyDate + MyRng.Value
MyDate2 = Find_Rng.Offset(, 1) + (MyRng.Value - 5)
With Sheets("MDay")
For i = .Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(i, "B").Value = MyDate Then
MyRng.Offset(, 1) = .Cells(i, "A").Value
ElseIf .Cells(i, "B").Value = MyDate2 Then
MyRng.Offset(, 2) = .Cells(i, "A").Value
End If
Next i
End With
End If
End If
Next
End If
End Sub
Private Function chk(trg As Range, MyRng As Range) As Boolean
'K列が変更した場合
Dim tmp As Variant
chk = False
Set tmp = Application.Intersect(trg, MyRng)
If Not tmp Is Nothing Then chk = True
End Function
Private Function chk2(trg As Range, MyRng As Range) As Boolean
'O列が変更した場合
Dim tmp As Variant
chk2 = False
Set tmp = Application.Intersect(trg, MyRng)
If Not tmp Is Nothing Then chk2 = True
End Function
|
|
たつ
- 11/1/14(金) 15:49 -
