Excel VBA質問箱 IV

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

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


6871 / 76735 ←次へ | 前へ→

【75460】Re:L列にデータが入ってたらI列に記入
発言  kanabun  - 14/4/4(金) 9:38 -

引用なし
パスワード
   ▼じん さん:

>マクロで読み込み、転記用シートにコピー
>転記用シートにコピーされたデータを本シートに転記していく感じです。
>L列は自動で転記されていきます。
>

別案です。
他のところからデータをコピーして貼り付けると、貼り付けたとき、
Changeイベントというのが発生します。この方法は、これを利用するもの
です。
以下のコードを シート見出し(シートタブ)を右クリックして出てくる
「コードの表示」メニューで表示されるコード・ウィンドウに貼り付けて
L列にデータ貼付けてみてください。

'// L列にデータが追加/更新/削除があったら自動実行する
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long
  Dim r As Range, c As Range
  Dim sa As String
  
  Set r = Intersect(Target, Range("L:L"))
  If r Is Nothing Then Exit Sub
  
  Application.EnableEvents = False 'イベントを一時的に無視
  For Each c In r
    If IsEmpty(c.Value) Then
      c.Offset(, -3).ClearContents
    Else
      Select Case c.Value
       Case Is >= 501: sa = "501 - "
       Case Is >= 451: sa = "451 - 500"
       Case Is >= 401: sa = "401 - 450"
       Case Is >= 351: sa = "351 - 400"
       Case Is >= 301: sa = "301 - 350"
       Case Is >= 251: sa = "251 - 300"
       Case Is >= 201: sa = "201 - 250"
       Case Is >= 151: sa = "151 - 200"
       Case Is >= 101: sa = "101 - 150"
       Case Else:   sa = "  - 100"
      End Select
      c.Offset(, -3).Value = sa
    End If
  Next
  Application.EnableEvents = True 'イベント復活
End Sub
3 hits

【75453】L列にデータが入ってたらI列に記入 じん 14/4/3(木) 12:05 質問
【75454】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/3(木) 13:22 発言
【75455】Re:L列にデータが入ってたらI列に記入 じん 14/4/3(木) 16:39 質問
【75456】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/3(木) 17:01 発言
【75457】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/3(木) 17:04 発言
【75458】Re:L列にデータが入ってたらI列に記入 じん 14/4/3(木) 17:55 質問
【75459】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/3(木) 19:19 発言
【75466】Re:L列にデータが入ってたらI列に記入 じん 14/4/7(月) 13:33 質問
【75467】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/7(月) 17:43 発言
【75468】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/8(火) 10:07 発言
【75460】Re:L列にデータが入ってたらI列に記入 kanabun 14/4/4(金) 9:38 発言
【75465】Re:L列にデータが入ってたらI列に記入 じん 14/4/7(月) 11:49 お礼

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