| |
おはようございます。
スマートでないですが、参考までに。
Sheet1が転記用シートです。
Sheet2がマスターです。
Sheet1のモジュールに貼り付けてください。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng2 As Range, r As Range
Dim EndC2 As Range
Dim r1 As Range, r2 As Range
Dim 行 As Long
Dim i As Long
Dim flag As String
If Target.Count > 1 Then Exit Sub
If (Target.Column - 1) * (Target.Column - 11) <> 0 Then Exit Sub
行 = Target.Row
If Cells(行, "A").Value = "" Then del 行: Exit Sub
If Cells(行, "K").Value = "" Then del 行: Exit Sub
'
Set EndC2 = Sheets("Sheet2").Range("A65536").End(xlUp)
Set rng2 = Sheets("Sheet2").Range("A2", EndC2) 'データ範囲（参照元）
'
flag = ""
For Each r In Range("A2", Range("A65536").End(xlUp))
If r.Row <> 行 Then
If Cells(行, "A").Value & Cells(行, "K").Value = _
Cells(r.Row, "A").Value & Cells(r.Row, "K").Value Then
Beep
MsgBox "重複"
Exit For
End If
End If
Next
'
Application.EnableEvents = False
For Each r2 In rng2
If r2.Value & r2.Offset(, 10).Value = _
Cells(行, "A").Value & Cells(行, "K").Value Then
Cells(行, "M").Value = r2.Offset(, 12)
Cells(行, "N").Value = r2.Offset(, 13)
GoTo jump
End If
Next
del 行
jump:
Application.EnableEvents = True
Set dic = Nothing
Set EndC2 = Nothing
Set rng2 = Nothing
Set r1 = Nothing
Set r2 = Nothing
End Sub
Private Sub del(r As Long)
Range(Cells(r, "m"), Cells(r, "n")).ClearContents
End Sub
|
|
kobasan
- 05/9/8(木) 7:52 -
