[[20140906222519]]　『エンタキーを押した時点で実行』（るるる）　ページの最後に飛ぶ

『エンタキーを押した時点で実行』（るるる）

 こんばんは
 いろいろマクロをわからないままにやっております。
 C列に日付、DE列にデータ、F列備考欄
 そこで．．．

 Sub るるる()

Dim Fst As String
Dim Cnt As Long
Set FRng = Range("A1:Z10000").Find("取消", LookAt:=xlWhole)
If Not FRng Is Nothing Then
Fst = FRng.Address
Do
FRng.Offset(, 3).Value = "別ファイルも参照"
Cnt = Cnt + 1
Set FRng = Range("A1:Z10000").FindNext(FRng)
Loop Until FRng.Address = Fst
End If

Set FRng = Range("A1:Z10000").Find("削除", LookAt:=xlWhole)
If Not FRng Is Nothing Then
Fst = FRng.Address
Do
FRng.Offset(, 3).Value = "担当に連絡"
Cnt = Cnt + 1
Set FRng = Range("A1:Z10000").FindNext(FRng)
Loop Until FRng.Address = Fst
End If
行 = 1

      Do While Cells(行, 4) <> ""
          文字列 = Cells(行, 3)
          If InStr(文字列, "取消") >= 1 Or _
            InStr(文字列, "削除") >= 1 Then
                  Cells(行, 4).Interior.ColorIndex = 4
                  Cells(行, 5).Interior.ColorIndex = 4
          End If
          行 = 行 + 1
      Loop

End Sub

 なんかいろいろコピーしたりで内容はわかってない部分もあるのですが、とりあえず
 ここまで出来ました。
 そしてもっと贅沢な希望が出てきました。

 これをC列に「削除」「取消」と入力-エンタキーを押した時点で DF列の背景色やF列に追記ができないものかと思っています。

 教えていただけるととても嬉しいのですが、よろしくお願いします。

＜使用 Excel：Excel2007、使用 OS：WindowsXP ＞

 これA1:Z10000で検索していますけど、見る限りC列だけですよね？
 該当するの。（取消とか削除が入力される列）
 このままイベントつけてもいいんですが、そのままだと処理に無駄があるので、
 必要なシートモジュールに以下のようなコードでいかがですか？

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
        Dim 背景色
        Dim 文字 As String
        Select Case Target.Value
            Case "取消"
                背景色 = 4
                文字 = "別ファイルも参照"
            Case "削除"
                背景色 = 4
                文字 = "担当に連絡"
            Case Else
                背景色 = xlNone
                文字 = ""
        End Select
        Application.EnableEvents = False
        Target.Offset(, 3).Value = 文字
        Target.Offset(, 1).Resize(, 2).Interior.ColorIndex = 背景色
        Application.EnableEvents = True
    End Sub
（稲葉） 2014/09/06(土) 23:47

 稲葉さん　ありがとうございます。とっても短いコードになって軽く？なったのですね。
 範囲もご指摘の通りです。

 たとえば、C列の日付をいっぺんに入力したくてドッラグしたり
 取消を入力したくて複数セルを選択すると．．．
 実行時エラー：型が一致しません．．．となって
  Case "取消"　が黄色　になっています。

 いっぺんに入力してもエラーにならない方法があれば教えていただけると助かります。

（るるる） 2014/09/07(日) 12:21

 これでいかがですか？
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
        Dim 背景色
        Dim 文字 As String
        Dim r As Range
        Application.EnableEvents = False
        For Each r In Target
            If Not Intersect(Range("C:C"), r) Is Nothing Then
                Select Case r.Value
                    Case "取消"
                        背景色 = 4
                        文字 = "別ファイルも参照"
                    Case "削除"
                        背景色 = 4
                        文字 = "担当に連絡"
                    Case Else
                        背景色 = xlNone
                        文字 = ""
                End Select
                r.Offset(, 3).Value = 文字
                r.Offset(, 1).Resize(, 2).Interior.ColorIndex = 背景色
            End If
        Next r
        Application.EnableEvents = True
    End Sub
（稲葉） 2014/09/07(日) 13:21

 ありがとうございます！！　稲葉さん
 そして今更気が付いたのですが、空白にすると背景色も塗りつぶしなしに戻っていたのですね！！
 その機能も必要だったのでとても助かりました。

（るるる） 2014/09/07(日) 13:40

 ＞空白にすると
 厳密に言えば、「取消」と「削除」どちらでもない場合で、空白ではないですね！
 Case Else
 の部分です。
（稲葉） 2014/09/08(月) 09:32

 稲葉さん　ありがとうございます。
 アドバイスもいただいてました。お礼が遅くなりました。

 ところでB列にも同じような機能が欲しくて

Private Sub Worksheet_Change(ByVal Target As Range)

        If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
        Dim 背景色
        Dim 文字 As String
        Dim r As Range
        Application.EnableEvents = False
        For Each r In Target
            If Not Intersect(Range("C:C"), r) Is Nothing Then
                Select Case r.Value
                    Case "取消"
                        背景色 = 8
                        文字 = "別ファイルも参照"
                    Case "削除"
                        背景色 = 8
                        文字 = "担当に連絡"
                    Case Else
                        背景色 = xlNone
                        文字 = ""
                End Select
                r.Offset(, 3).Value = 文字
                r.Offset(, 0).Resize(, 3).Interior.ColorIndex = 背景色
            End If
        Next r
        Application.EnableEvents = True

        If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub

        Application.EnableEvents = False
        For Each r In Target
            If Not Intersect(Range("B:B"), r) Is Nothing Then
                Select Case r.Value
                    Case "取消"
                        背景色 = 8
                        文字 = "別ファイルも参照"
                    Case "削除"
                        背景色 = 8
                        文字 = "担当に連絡"
                    Case Else
                        背景色 = xlNone
                        文字 = ""
                End Select
                r.Offset(, 3).Value = 文字
                r.Offset(, 0).Resize(, 3).Interior.ColorIndex = 背景色
            End If
        Next r
        Application.EnableEvents = True
    End Sub

 そうしたところ．．．B列に『削除』と入力しても何の変化もありません。
 どこがおかしいのですか？

（るるる） 2014/10/17(金) 20:35

 ブレークポイントを頭につければ一発でわかるんですが・・・
 覚える気はないんですよね？

 C列orB列？
 それともC列AndB列？
 とりあえず前者
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Range("B:C")) Is Nothing Then Exit Sub
        Dim 背景色
        Dim 文字 As String
        Dim r As Range
        Application.EnableEvents = False
        For Each r In Target
            If Not Intersect(Range("B:C"), r) Is Nothing Then
                Select Case r.Value
                    Case "取消"
                        背景色 = 4
                        文字 = "別ファイルも参照"
                    Case "削除"
                        背景色 = 4
                        文字 = "担当に連絡"
                    Case Else
                        背景色 = xlNone
                        文字 = ""
                End Select
                Cells(Target.Row, "F").Value = 文字
                Cells(Target.Row, "D").Resize(, 2).Interior.ColorIndex = 背景色
            End If
        Next r
        Application.EnableEvents = True
    End Sub

（稲葉） 2014/10/17(金) 20:48

ありがとうございました。
（るるる） 2014/10/17(金) 22:35

コメント返信：

[ 一覧(最新更新順) ]

[[20140906222519]] 『エンタキーを押した時点で実行』（るるる） ページの最後に飛ぶ

[[20140906222519]]　『エンタキーを押した時点で実行』（るるる）　ページの最後に飛ぶ