| |
ありがとうございます。参考になりました。
でも、他の判定も入れておきましたがエラーになった。
IFエラーだって。どこが悪いですか？
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myPoint As String
Dim ws As Worksheet, ws_d As Worksheet
Dim r As Range 'FIND用
Dim i As Long
Set ws_d = Worksheets("data")
Set ws = Worksheets("ストレス判定")
If Target.Address = Range("AW2").Address Then
If Target.Address = Range("AX2").Address Then
If Target.Address = Range("Ay2").Address Then
If Target.Address = Range("Az2").Address Then
If Target.Address = Range("BA2").Address Then
myPoint = Target.Value 'ポイント
'ポイントをもとに、dataシートのリストを検索
Set r = ws_d.Range("B2:BA2").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '仕事
Set r = ws_d.Range("B6:AR6").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '精神的
Set r = ws_d.Range("B10:AF10").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '身体的
Set r = ws_d.Range("B14:K14").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '疲労
Set r = ws_d.Range("B18:T18").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '抑うつ
'リストに見つからないとき
If r Is Nothing Then
MsgBox "無効な値です"
Exit Sub
End If
i = r.Offset(1).Value '図形位置
ws.Shapes("仕事").Top = ws.Range("AV5").Top
ws.Shapes("精神").Top = ws.Range("D25").Top
ws.Shapes("身体").Top = ws.Range("AV25").Top
ws.Shapes("疲労").Top = ws.Range("D43").Top
ws.Shapes("抑うつ").Top = ws.Range("AV43").Top
'セル値に応じて横方向にオフセット
ws.Shapes("仕事").Left = ws.Range("AV5").Offset(0, i - 1).Left
ws.Shapes("精神").Left = ws.Range("D25").Offset(0, i - 1).Left
ws.Shapes("身体").Left = ws.Range("AV25").Offset(0, i - 1).Left
ws.Shapes("疲労").Left = ws.Range("D43").Offset(0, i - 1).Left
ws.Shapes("抑うつ").Left = ws.Range("AV43").Offset(0, i - 1).Left
End If
End Sub
|
|
さる
- 04/7/17(土) 0:30 -
