| |
試してみてください。
メッセージボックスがでる場合、最初に提示した
> シート名『1』のセルＡ5に数字「1」を入力するとシート名『Ａ』のセルB20の
> 値をシート名『1』のセルA6に貼り付ける。
> シート名『1』のセルＡ5に数字「2」を入力するとシート名『Ｂ』のセルB20の
> 値をシート名『1』のセルA6に貼り付ける。
が間違っています。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As String
With Target
' A5以外の変更は何もしない
If .Address(0, 0) <> "A5" Then Exit Sub
' セルの数が1で無い場合も何もしない
If .Cells.Count > 1 Then Exit Sub
' セルの値で切り分け
Select Case .Value
Case 1: Sh = "A"
Case 2: Sh = "B"
' 1, 2ではない
Case Else
MsgBox "1か2じゃねぇよ。"
Exit Sub
End Select
Application.EnableEvents = False
On Error Resume Next
' 指定のシートのB20の値をA6に入れる
.Offset(1).Value = Worksheets(Sh).Range("B20").Value
If Err.Number <> 0 Then
MsgBox "'" & Sh & "'ってシートないじゃん。"
End If
On Error GoTo 0
Application.EnableEvents = True
End With
End Sub
ついでに、類似スレ
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=38974;id=excel
も参考にしてください。
|
|
Blue
- 06/6/15(木) 17:26 -
