• ベストアンサー

WorkSheet _Change を使って

たびたびお世話になります。 worksheet_changeを使うマクロを作成しています。 sheet１で入力されたデータがsheet2にあるデータベースの文字と一致した場合、sheet１の該当セル（入力した部分）の色を変えます。 もしそのセルの内容が変更、削除された場合は塗りつぶしなしに戻します。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sTitle As String sTitle = Target.Value If sTitle = "aaa" Then Target.Interior.ColorIndex = 7 Else Target.Interior.ColorIndex = xlNone End If End Sub このコードで、「aaaという文字を入れたら色を変える／削除・変更されたらは塗りつぶしなし」という動作はできました。 しかしその後、aaaに当たる項目が増え、項目自体を変更する可能性も増えたので、上記のように別シートにデータベースを作ることにしたのです。 このコードを基にしてプログラムを組んだのですが、うまく参照が出来てないようでコンパイルエラーになってしまいます。 アイディアでも良いのでアドバイスをお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • pbforce
  • ベストアンサー率22% (379/1719)
回答No.2

すいません修正です。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sTitle As String sTitle = Target.Value For i = 1 To Sheets("Sheet2").Range("A1").End(xlDown).Row If sTitle = Sheets("Sheet2").Cells(i, 1).Value Then Target.Interior.ColorIndex = 7 Exit For Else Target.Interior.ColorIndex = xlNone End If Next i End Sub

nepa-aiko
質問者

お礼

ありがとうございます！ 動作しました。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (3)

  • squip
  • ベストアンサー率16% (2/12)
回答No.4

関数、リスト、そして条件付き書式による単純な解決案 A1: aaa 　　条件付き書式の設定 　　数式が　=$C$1 C1: =NOT(ISNA(MATCH(A1,C2:C4,0))) C2: aaa C3: ggg C4: zzz

nepa-aiko
質問者

お礼

回答ありがとうございます。 条件つき書式だと４つくらい？しか設定できないですよね？ 該当のデータは20くらいあります。

全文を見る
すると、全ての回答が全文表示されます。
  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.3

「データベース」がSheet2のA列にあるとします 　If sTitle = "aaa" Then の１行を 　If Application.CountIf(Sheets("Sheet2").Columns(1), sTitle) > 0 Then に変更したらどうですか？ ワークシート関数のCOUNTIFで合致する文字列があったとき処理をします。コードは直打ちしていますのでスペルミスがあるかもしれません。そのときは訂正してください

nepa-aiko
質問者

お礼

回答ありがとうございます。 勉強になりました。 参考にさせていただきます。

全文を見る
すると、全ての回答が全文表示されます。
  • pbforce
  • ベストアンサー率22% (379/1719)
回答No.1

動いているコードを書いてもらっても、参考になる回答は出来ませんよ。 うまく行かないところのコードを書いて下さい。 また、Sheet2のデータベースはどのような形のものかもわかると回答しやすくなります。 Sheet2のA列に並んでいるデータに同じデータがあれば～～という条件判断は・・・ For i=1 To Sheets("Sheet2").Range("A1").End(xlDown).Row If sTitle = Sheets("Sheet2").Cells(i,1).Value Then Target.Interior.ColorIndex = 7 Else Target.Interior.ColorIndex = xlNone End If と言う方法があります。 が、シートモジュールから他のシートを参照するコードが書けるか不安になってきましたので、要調査です。 試してみてダメなら、補足を下さい。

nepa-aiko
質問者

補足

すみません。 業務の都合上そのエクセルブックをリリースしなければならなくなったので。 うまくいかない部分は後回しにすることにして、ひとまずコメントアウトしておいたんですが。 そのせいか？他の部分にエラーが出てしまったので、やむなく削除してしまったのです・・・。（そうしたらなぜか正常動作するようになりました） たしか「オブジェクトがありません」というエラーメッセージが出ていました。 sheet2は、Ａ列の部分に文字データが並んでいるだけです。

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • WorkSheet _Change について

    いつもお世話になっています。 今、セルにある特定の文字列が入力されたら、セルの色を変えるという処理を作成しています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sTitle As String sTitle = Target.Value If sTitle = "aaa" Then Target.Interior.ColorIndex = 16 End If End Sub コードはこんな感じです。（動作確認済み） たしかに特定の文字列を察知してシートの色を変えることはできるんですが、今作成しているものは随時セルの中身が更新されるのです。 そこで、別の文字列が入力されたら（もしくは文字列が削除されたら）もとの白色に戻る、という処理はできますでしょうか。

  • エクセルVBAの記述法（Worksheet_Changeで）

    入力があればセルが黄色のなり、入力がなければ無色とするマクロです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Value <> "" Then Target.Interior.ColorIndex = 6 Else Target.Interior.ColorIndex = xlNone End If End Sub このように書くと、通常は正しく動きますが、ドラッグした場合や、複数セルを一度にクリアした場合、エラーになってしまいます。 ただしく作動させるにはどう直せばいいのでしょうか？

  • エクセル　VBA　Worksheet_Changeとコピー＆ペースト

    いつも皆様には大変お世話になっております。 早速の質問ですが Worksheet_Changeを使ってマクロを組んでいるのと フォームを使ってマクロを組んでいます フォームのほうからのマクロで　Sheet1のセルをコピーしてSheet2のセルに貼り付けをしたいのですが、 貼り付けができません。 フォームのほうからのマクロじゃなく手動でコピー＆ペーストも利きません。コピーはできるのですがSheet2に変えたところ貼り付けができなくなってしまいます。 Worksheet_Changeのマクロを消すと動きました。どうにかならないでしょうか？ ちなみにWorksheet_Changeの中のマクロは Private Sub Worksheet_Change(ByVal Target As Range) If Range("J48") = Range("J68") Then Range("J48").Interior.ColorIndex = xlColorIndexNone Else Range("j48").Interior.ColorIndex = 26 End If If Range("V48") = Range("V68") Then Range("V48").Interior.ColorIndex = xlColorIndexNone Else Range("V48").Interior.ColorIndex = 26 End If End Sub となっています。 何かいい解決法がありましたらご教授のほどよろしくお願いいたします。

  • エクセル：Worksheet_Changeのエラー回避

    A列のセルに数字（数字かどうかの判断は無くて良い）が入ったらその隣のセルを青で塗りつぶす、 といったマクロを組んでいます。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Target.Offset(0, 1).Interior.ColorIndex = 5 End if End sub 以上をシートに直接（←呼び方がわかりません。「標準モジュール」ではない所）書込んだら動作しました。 このコードだと、行を削除した時に、 「アプリケーション定義またはオブジェクト定義のエラーです」というエラーで止まってしまいます。 A列のセルに変更があったけど塗るセルが無いから、とかそれっぽい理由は思いつくのですが、 どのように書けばエラーを回避（セルが無い場合は＊＊＊、みたいな記述でしょうか）できるでしょうか。 なるべく On Error Resume Next は使いたくないです。 （勝手な印象ですが、なんかエラーを無視してるみたいで落ち着かない…）

  • WorkSheet_Changeを2つ反映させる

    　下記のコードをWorkSheetで2つ反映させるにはどうしたらいいでしょうか？どちらか一つなら反映するのはわかりますが、どう名前を変更すればいいのかお教え願えませんでしょうか？ windows7・SP1 Office2010 Private Sub WorkSheet_Change(ByVal Target As Range) If Intersect(Target, Range("C1")) Is Nothing Then Exit Sub '検査範囲 Application.EnableEvents = False '再帰実行の停止 If Range("C1").Value <> Sheets("祝祭日").Range("A1").Value Then MsgBox ("祝日の設定を反映するため年度を同じにしてください。") End If Application.EnableEvents = True End Sub Private Sub WorkSheet_Change(ByVal Target As Range) Dim MyRow As Long Dim MyCol As Integer MyRow = Target.Row MyCol = Target.Column With Worksheets("メイン・1").Select If MyRow = 1 And MyCol = 7 Then If Target = 4 Then 'または　If Target = 1 Then メインデータの復元 '動かしたいマクロ名 End If End If End With End Sub

  • Worksheet_Changeが動かない

    エクセル自動実行のマクロを作成中にうまく動かないので サンプルをコピーして、変更してみたのですが そのサンプルも動いません、マクロとは違う何か悪いのでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim intColor As Integer If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B2:B11")) Is Nothing Then Exit Sub Select Case Target.Value Case Is <= 20 intColor = 3 Case 21 To 40 intColor = 46 Case 41 To 60 intColor = 9 Case 61 To 80 intColor = 10 Case Is > 80 intColor = 5 End Select Target.Font.ColorIndex = intColor Application.EnableEvents = True End Sub

  • エクセルVBA 双方向での書式のリンク方法

    エクセルVBAにて双方向での書式のリンクをさせたいと考えています。 具体的にはセルの背景色の双方向リンク方法について教えていただきたいです。ここで双方向での背景色のリンクとは別々のシート上のセルの背景色をどちら側の変更であっても、もう一方に変更を反映させることです。 【シート１】 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("Sheet2").Range("$A$1").Value = Sheets("Sheet1").Range("$A$1").Value Sheets("Sheet2").Range("$A$1").Interior.ColorIndex = Sheets("Sheet1").Range("$A$1").Interior.ColorIndex End If End Sub 【シート２】 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("Sheet1").Range("$A$1").Value = Sheets("Sheet2").Range("$A$1").Value Sheets("Sheet1").Range("$A$1").Interior.ColorIndex = Sheets("Sheet2").Range("$A$1").Interior.ColorIndex End If End Sub 上記のコードを記述しています。値のリンクはできているのですが背景色のリンクがどうしてもうまくできません。どちらかの変更と同時にもう一方の背景色も変更されるようにするにはどうすればよいでしょうか？ どんな方法でもかまいませんのでお詳しい方よろしくお願いします。

  • 「Worksheet_Change」で２つの操作を

    お世話になります。 当方、エクセルの超初心者です。 仕事で、ある作業表の作成を任されたのですが、一部が思い通りに動作しません。 最初は「例１」のような記述によりエラーしました。 【例１】 Private Sub Worksheet_Change(ByVal Target As Range） （内容１） End Sub Private Sub Worksheet_Change(ByVal Target As Range） （内容２） End Sub その後、過去の回答にあった類似案件を参考に「例２」のように書き換えましたが、 実行されるのは１つ目のみで、２つ目の内容は無視され、困っております。 【例２】 Private Sub Worksheet_Change(ByVal Target As Range） （内容１） （内容２） End Sub ちなみに実データは以下の通りです。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count <> 1 Then Exit Sub If Intersect(Target, Range("k6:k55")) Is Nothing Then Exit Sub If Target.Value = "" Then Target.Value = "○" Else Target.Value = "" If Target.Count <> 1 Then Exit Sub If Target.Column <> 2 Then Exit Sub If Target.Row < 6 Or Target.Row > 45 Then Exit Sub Call ShowCalendarFromRange2(Target) End If End Sub 見様見真似で作ったため、恥ずかしながら基本が全く理解できていません。 恐らく簡単なミスだと思うのですが、自力では解決方法を探し出せませんでした。 何とか２つの内容が実行できないものでしょうか。 どうか、お知恵をお貸し下さい。

  • linkとWorksheet_Change

    LINK　してあるセルを　ターゲットにして　Worksheet_Change　をとっても　反応しない。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address　<> "$B$2" Then Exit Sub 　　Msg = MsgBox("bが変更されました。", vbOKCancel) 　　tensou この$B$2は　他の部分からデータを得ています。時間でこのセルの値が自動で変化するのですが Worksheet_Change　起きないのか、捉えられないのか、分かりかねますが その下$B$3に　＝$B$2　もしくは　＝Value（$B$2）　で　飛ばして　Target.Address <> "$B$3"にしても　同じ。 このLINKした　セルの　Worksheet_Change　イベントを　ひらう方法を　お教え願えませんでしょうか IF　分を　＝で置き換えても同じでした。

  • エクセル　ＶＢＡ　セルの色をSheet1とSheet2の両方を変えたいのですが・・・

    最近困っているところが表題の通りなのですが Sheet1のＢ２を右クリックするとＢ２のセルの色を変えて Sheet2のＢ２のセルも色を変えたいというものです。 現状で Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim Rng As Range, myRng As Range Dim RngA As Range, myRngA As Range Set Rng = Range("B3:W3,b7:w8,b12:w12,d13:w13,d17:w18,d22:w23") Set myRng = Intersect(Target, Rng) If myRng.Interior.ColorIndex = xlColorIndexNone Then myRng.Interior.ColorIndex = 37 Else If myRng.Interior.ColorIndex = 37 Then myRng.Interior.ColorIndex = 45 Else myRng.Interior.ColorIndex = xlColorIndexNone End If End If Cancel = True End Sub とここまではあるのですが、これをどう改造すればSheet2の同じセルの色もかわるのでしょうか？ 宜しくお願いいたします

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する