| |
このような処理は、何かのイベントマクロを使ってやるのが便利です。
中でも最も適しているのは、右クリックイベントではないかと思います。
で、以下のコードを運送予定シートのシートモジュールに入れ、処理したい No を
右クリックして下さい。その際、もし複数の No を一気に処理したいなら Ctrlキー
を押しながら左クリックで選択(連続した範囲なら Shiftキー を使う)していき、
最後に右クリックして下さい。ループによって連続処理します。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
Dim Sh As Worksheet
Dim C As Range
Dim CkR As Variant
Set Sh = Worksheets("運送実績")
For Each C In Target
If Intersect(C, Range("A:A").SpecialCells(2)) _
Is Nothing Then GoTo NLine
If C.Offset(, 25).Value = "済" Then
CkR = Application.Match(C.Value, Sh.Range("A:A"), 0)
If Not IsError(CkR) Then
Intersect(C.EntireRow, Range("B:B, D:R")) _
.Copy Sh.Cells(CkR, 2)
Else
Debug.Print C.Value & " : NotFound"
End If
Else
'項目修正マクロの処理内容を、ユーザーフォームを出す
'代わりに InputBox で処理するコードをここに書く
End If
NLine:
Next
Set Sh = Nothing: MsgBox "転記処理を終了します", 64
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
