Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5105 / 76732 ←次へ | 前へ→

【77240】Re:ルーブ
発言  kanabun  - 15/6/25(木) 13:01 -

引用なし
パスワード
   ちょっと出かけますので、とりあえずあてずっぽで m(_ _)m

'入力のあったセルが [E2]のときは (1) を実行し、
'[D6:D10]のときは (2)を実行するように If〜 Else〜 End If構文で分岐処理して
'ください

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Dim c As Range
'(1) -----------------------------------------------------------
If Target.Address(0, 0) = "E2" Then
  Dim m As Variant
  With Worksheets("詳細") '別シートのコード照合セル範囲
    Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
  End With
  Application.EnableEvents = False
  If IsEmpty(Target) Then
    Target.Offset(1).ClearContents
  Else
    m = Application.Match(Target, Rg, 0) 'Match関数で検索
    If IsNumeric(m) Then
      Target.Offset(1).Value = Rg.Item(m, 2).Value
    Else
      Target.Offset(1).ClearContents
      MsgBox "入力されたコードはありません"
    End If
  End If
  Application.EnableEvents = True
  
'(2) -----------------------------------------------------------
Else
  Set Rg = Intersect(Target, Range("D6:D10"))
  If Rg Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each c In Rg
    If Not IsEmpty(c.Value) Then
      c.Offset(, -1).Value = Range("E3").Value
    End If
  Next
  Application.EnableEvents = True
  
End If
End Sub
415 hits

【77235】ルーブ 翔子 15/6/25(木) 11:10 質問[未読]
【77236】Re:ルーブ kanabun 15/6/25(木) 12:05 発言[未読]
【77237】Re:ルーブ 翔子 15/6/25(木) 12:37 質問[未読]
【77239】Re:ルーブ kanabun 15/6/25(木) 12:46 発言[未読]
【77240】Re:ルーブ kanabun 15/6/25(木) 13:01 発言[未読]
【77238】Re:ルーブ kanabun 15/6/25(木) 12:43 発言[未読]
【77241】Re:ルーブ 翔子 15/6/25(木) 14:38 質問[未読]
【77242】Re:ルーブ kanabun 15/6/25(木) 15:06 発言[未読]
【77243】Re:ルーブ 翔子 15/6/25(木) 15:22 質問[未読]
【77244】Re:ルーブ 翔子 15/6/25(木) 15:35 質問[未読]

5105 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free