|
▼ponpon さん:
>>>Private Sub Worksheet_Change(ByVal Target As Range)
>>> Dim hinmei As String, keijyou As String
>>> Dim myRange As Range
>>> Dim endRow As Long
>>> Dim a As Variant
>>> Dim i As Variant
>>>
>>> With Target
>>> On Error GoTo errEnd
>>> If .Column <= 1 Or .Column >= 3 Or _
>>> .Row = 1 Or .Value = "" Then End
> ~~~~~~~~~~~~~~~~
> 'ここを削除
>
>>>
>>> Select Case .Column
>>> Case 1
>>> If .Offset(, 1).Value = "" Then Exit Sub
>>> hinmei = .Value
>>> keijyou = .Offset(, 1).Value
>>> GoTo kakuninEvent
>>> Case 2
>>> If .Offset(, -1).Value = "" Then Exit Sub
>>> hinmei = .Offset(, -1).Value
>>> keijyou = .Value
>>> GoTo kakuninEvent
>>> End Select
>>>
>>> Exit Sub
>>>
>>>kakuninEvent:
>>> Set myRange = Range("A2", Cells(Cells.Rows.Count, 1).End(xlUp).Offset(-1)).Resize(, 5)
>>> a = myRange.Value
>>> Application.EnableEvents = False
>>> Range("C" & .Row).ClearContents
>>> Range("E" & .Row).ClearContents
>>> Application.EnableEvents = True
>>> For i = 1 To myRange.Rows.Count
>>> If hinmei = a(i, 1) And keijyou = a(i, 2) Then
>>> Application.EnableEvents = False
>>> Range("C" & .Row).Value = a(i, 3)
>>> Range("E" & .Row).Value = a(i, 5)
>>> Application.EnableEvents = True
>>> Exit For
>>> End If
>>> Next i
>>>
>>> End With
>>>errEnd:
>>>
>>>End Sub
>>ponpon さん返事ありがとうございます。
>>応援のメッセージいただき大変気分が爽快です。
>>上記コード確認いたしました ただですね
>>> Range("C" & .Row).ClearContents
>>> Range("E" & .Row).ClearContents
>>でクリアしてると思うのですがたとえばB列をdeleteしても形状の違う値を
>>記入しても前のデータが残ってしまっています。ponponさんのPCでは正常でしょうか?
>とりあえず、ここだけ!
>
>>あとC列に式と記入した場合通常は1式なので数量(D列)に1を記入できませんか
>>重ね重ねよろしくお願いします。(-_-;)
削除するのは Or .Value = "" ←この分でよろしかったでしょうか
これだとするとC,E列いままでOKだった数値が表示されなくなってしまうのですが
どうでしょうか
|
|