VBAでのセルの複数選択時の処理について

前へ 次へ
このQ&Aのポイント
  • EXCEL VBAで行の値が変わったときにその列の塗りつぶしの色を変える処理を作成しているが、複数選択して値を変えた場合にエラーが発生する。修正方法を教えてください。
  • VBAで複数選択時の処理に関して、エラーが発生する問題があります。具体的には、行の値が変わった際にその列の塗りつぶしの色を変える処理を行っていますが、複数選択した場合にエラーが表示されます。修正方法を教えてください。
  • VBAを使用してEXCELのセルの複数選択時の処理を作成しています。行の値が変わったときにその列の塗りつぶしの色を変える処理ですが、複数選択するとエラーが発生します。修正方法を教えてください。
回答を見る
  • ベストアンサー

VBAでのセルの複数選択時の処理について

現在EXCEL VBAである行の値が変わったときにその列の塗りつぶしの 色を変えるといった処理を作成しております。 そこで、複数選択して値を変えた場合の処理が変数の型が一致しません 的なエラーが表示されてしまいます。 どのように修正したらうまくいくでしょうか？ 教えてください。 ソースは下記の通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False MsgBox (Target.Rows.Count) Dim rngSelectRng As Range For Each rngSelectRng In Target If rngSelectRng.Value = "" Then rngSelectRng.Value = " " 'ステータス欄の入力の判断 'Select Case Target.Rows.Value MsgBox (Target.Row) Select Case rngSelectRng.Value Case "あああ" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 24 Case "いいい" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 35 Case "ううう" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 38 Case "えええ" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 36 Case "おおお" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 16 Case Else Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 2 End Select Next Application.EnableEvents = True End Sub

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

  • ベストアンサー
  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.1

上記のコードで試してみましたが、複数選択してもエラーは出ませんでした。どの行でエラーが出たのでしょうか。 ただ、複数選択して値を変えても、一番上の行しか色がつきません。これは、 Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 24 を Worksheets("表１").Rows(rngSelectRng.Row).Interior.ColorIndex = 24 にすると解決しました。 それから、 Worksheets("表１").Rows(rngSelectRng.Row).Interior.ColorIndex = というのを羅列すると、見栄えもよくないし、あとから修正するのも大変なので、 With Worksheets("表１").Rows(rngSelectRng.Row).Interior 　Select Case rngSelectRng.Value 　Case "あああ" 　　.ColorIndex = 24 　　　　： 　　　　： 　End Select End With とした方がよいかと思います。

ryota0117
質問者

お礼

早速確認してみたところうまく動作いたしました。 ご回答、ありがとうございました。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • VBAのセルの色の設定について

    EXCEL・VBAにて.Interior.Color=RGB(152, 251, 152)と設定しましたが 思った色(緑系の色)ではなくグレー系の色になってしまったのですが、 何か間違っているのでしょうか？ 何かわかる方いらっしゃいますでしょうか？ 実際のソースはしたの通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False 'ステータス欄の入力の判断 Select Case Target.Value Case "あああ" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(152, 251, 152) Case "いいい" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(254, 208, 224) Case "ううう" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(255, 255, 0) Case "えええ" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(192, 192, 192) Case Else Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(255, 255, 255) End Select Application.EnableEvents = True End Sub

  • [VBA] セルの色を塗りつぶす

    条件付き書式では出来ないみたいなので、VBAに挑戦しましたが苦労しています。 Win 8, excel 2010です。 「ある１つのセルが100の時、その左横の4列をある色で塗りつぶす」 という事を行いたいのですが、 ネットで調べたものをちょっとアレンジしてみましたが Sub change(ByVal Target As Range) Dim myColor As Variant If Target.Count <> 1 Then Exit Sub If Target.Column <> 4 Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case 100 myColor = 3 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 4).Interior.ColorIndex = myColor Application.EnableEvents = True End Sub change(関数名)の横に引数があるから(参照渡し？？？) マクロに表示されないという情報を 見つけたのですが、色々やっても訳が分からなくなりました。 どうすれば実行できるようになるのでしょうか？

  • VBA　CHANGEイベントに複数イベントを

    いつもお世話になっています。 色々しらべて試してみたんですが、うまくいかないんで教えてください。 CHANGEイベントに複数のイベントを書き込みたいんですが。 今現在、問題なく動いている以下のイベントがあります。 (1) Private Sub Worksheet_Change(ByVal Target As Range) Dim rang3 As Range Dim rang4 As Range Dim ■■ As String Dim LastRow1 As Long LastRow1 = Worksheets("○○").Cells(Rows.Count, "b").End(xlUp).Row Set rang4 = Worksheets("○○").Range("b:I" & LastRow) Set rang3 = Range("h4") If Intersect(Target, rang3) Is Nothing Then Exit Sub On Error Resume Next ■■ = WorksheetFunction.VLookup(Target.Value, rang4, 2, 0) If Err.Number > 0 Then MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" Range("h4").Select Else Application.EnableEvents = False Range("I4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 2, False) Range("j4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 3, False) Range("k4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 7, False) Range("l4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 8, False) Range("m4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 5, False) Application.EnableEvents = True Range("K4").Select End If End Sub このシートにもう一つ、イベントを入れたいのですが。 (2) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("E4")) Is Nothing Then Exit Sub Else If Range("e4").Value = "1" Then Target.Offset(0, 19).Value = "☆" End If どこに入れればいいのかわかりません。 (3) また、(2)のイベントの他に、 (1)のＶＬＯＯＬＵＰが実行され、尚且つ(2)のイベントのＥ４が値が１だった場合、Ｙ４にＨ４の値を入れたいのですが・・・。 (2)のみなら動くことは確認できましたが、(1)のｅｘｉｔ　ｓｕｂ　の直前に入れたり、ｅｎｄ　ｉｆの前に入れたりしましたが、片方は動くが、もうひとつが動かないです。 (3)については、まったくわかりません。 マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。 どなたか、教えてください。 お願いします。

  • Excelで選択しているセルの行を色づけしたい

    以前、このサイトでVBAを以下のように設定したのですが、 一度、ファイルを閉じてしまうと、無効になってしまいます。どうすれば、いいのでしょうか？ Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) ActiveSheet.Rows.Interior.ColorIndex = xlNone Rows(Target.Row).Interior.ColorIndex = 15 End Sub

  • VBAで別の列のセルにも色付け～２

    WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 ご迷惑とは重々と承知しながら再度質問させていただきます。 １　御指導を賜りたいのは、 現在A列には月度を示す　０１～１２　が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。 例えば参照図で言うと A７　０５　ピンク　 A８　０５　ピンク A９　０６　ライトブルー　 A１０　０７　草色　等のように ※ 参照図のF列のセルには背景色は適用していません。 ２　参照図のそれぞれの設定は、　　 ※ 計画　と　生産はセル位置だけの違いで生産の方は割愛します。 D１　ユーザー定義　mm/dd D２　ユーザー定義　２０００００ D３　数値 A７　ユーザー定義　mm マクロ ボタン「計画入力」 Sub 計画入力() Dim GYOU '追加 GYOU = Range("C65536").End(xlUp).Row + 1 Cells(GYOU, 2).Value = Range("D1").Value Cells(GYOU, 3).Value = Range("D2").Value Cells(GYOU, 4).Value = Range("D3").Value End Sub ボタン「セルセット」 Sub 計画セル() 　　 Range("D1,D2,D3,D1").Select End Sub A列のセル塗りつぶし Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, 0).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 御指導よろしく御願いします。

  • VBAでセルの色付を別の列にも追加するには

    WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 現在下記の如く、 A列にマクロを設定しています。 ※A F列には下記の数式が入っています。 A2 =IF(B2="","",TEXT(B2,"mm")) F2 =IF(G2="","",TEXT(G2,"mm")) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, -1).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 上記のマクロに追加でF列にも同様にセルの色付けするにはどうすればいいか ご教授を御願いできないでしょうか。

  • セルの選択でその行に色を付けたい

    横に長いデータがあり、その1つのセルを選択するとその行全体に色が付くようにしたいのです。過去の質問で以下のようなものを見つけましたが、問題はその場合、通常のコピー→貼り付けができない点です。 その辺を問題なく行える方法はないでしょうか？ よろしくお願いいたします。 Public m, n Private Sub Worksheet_SelectionChange(ByVal Target As Range) If m <> 0 Then Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = n End If m = Target.Row n = Target.Interior.ColorIndex Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6 End Sub

  • セルの塗りつぶしマクロを作ったのですが・・

    初めて投稿します。どうぞよろしくお願いします。 エクセルの条件付き書式では4通りにしか設定できないため、マクロ初心者ではありますが、こちらでの回答を参考に作ってみました。 0～0.999　薄ピンク 1～1.999　ピンク 2～2.999　赤 3～3.999　オレンジ 　　↓ 　　↓ 25～25.999　濃い紫 と26パターンに自動的に塗りつぶすマクロを作りました。 ところが空白のセルも0～0.999で指定している薄ピンクに塗りつぶされてしまいます。 何分初心者なもので、どこを修正したら良いのかわかりません。 どなたかアドバイス頂けると助かります。 よろしくお願いします。 Sub color0_25() Dim Target As Range For Each Target In Range("A1:Z1000") Select Case Target.Value Case Is < 0 Target.Interior.ColorIndex = 0 Case Is < 1 Target.Interior.ColorIndex = 38 Case Is < 2 Target.Interior.ColorIndex = 7 Case Is < 3 Target.Interior.ColorIndex = 22 Case Is < 4 Target.Interior.ColorIndex = 3 Case Is < 5 Target.Interior.ColorIndex = 46 Case Is < 6 Target.Interior.ColorIndex = 45 Case Is < 7 Target.Interior.ColorIndex = 44 Case Is < 8 Target.Interior.ColorIndex = 6 Case Is < 9 Target.Interior.ColorIndex = 36 Case Is < 10 Target.Interior.ColorIndex = 35 Case Is < 11 Target.Interior.ColorIndex = 4 Case Is < 12 Target.Interior.ColorIndex = 50 Case Is < 13 Target.Interior.ColorIndex = 14 Case Is < 14 Target.Interior.ColorIndex = 34 Case Is < 15 Target.Interior.ColorIndex = 37 Case Is < 16 Target.Interior.ColorIndex = 33 Case Is < 17 Target.Interior.ColorIndex = 28 Case Is < 18 Target.Interior.ColorIndex = 41 Case Is < 19 Target.Interior.ColorIndex = 5 Case Is < 20 Target.Interior.ColorIndex = 11 Case Is < 21 Target.Interior.ColorIndex = 55 Case Is < 22 Target.Interior.ColorIndex = 17 Case Is < 23 Target.Interior.ColorIndex = 39 Case Is < 24 Target.Interior.ColorIndex = 54 Case Is < 25 Target.Interior.ColorIndex = 13 Case Is < 26 Target.Interior.ColorIndex = 21 End Select Next End Sub

  • ドラッグした際のエラー回避

    以下のようなVBAを組んだのですが、オートフィルタでV列をリストのいずれかを選択中にドラッグすると「型が一致しません」というエラーを起こします。 最悪、オートフィルタ中はドラッグ不可でもかまいません。 ご教授ください。 （WiｎXp/Access2003) Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) '列の色変更 Dim myColor As Variant Dim myFontColor As Variant If Target.Column = 1 Then GoTo S If Target.Column = 9 Then GoTo K If Target.Column = 25 Then GoTo Y If Target.Column = 22 Then GoTo A If Selection.Cells.Count > 1 Then Exit Sub Exit Sub S: 'A列入力時 If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 4) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, 2) = "TypeA" Target.Offset(0, 5) = "未" Target.Offset(0, 6) = Date Target.Offset(0, 1).Select End If Application.EnableEvents = True Exit Sub K: '故障入力時 If Not Intersect(Target, Range("K1:K10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = "Y" Then Target.Offset(0, 13) = "故障" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 7 Target.Offset(0, 1).Select Else End If Application.EnableEvents = True Exit Sub Y: 'Y列入力時 If Not Intersect(Target, Range("Y1:Y10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 1) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, -3) = "売却済" Target.Offset(0, 1) = Date Target.Offset(0, 2) = "未" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 16 Else End If Application.EnableEvents = True Exit Sub A: If Not Intersect(Target, Range("A1:AB10")) Is Nothing Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case "故障" myColor = 7 'ピンク myFontColor = 1 Case "修理中" myColor = 37 '薄い水色 myFontColor = 1 Case "担当出(1)" myColor = 3 '赤 myFontColor = 1 Case "担当出(2)" myColor = 8 '水色 myFontColor = 1 Case "担当出(3)" myColor = 4 '蛍光緑 myFontColor = 1 Case "担当出(4)" myColor = 6 '黄色 myFontColor = 1 Case "担当出(5)" myColor = 5 '青 myFontColor = 1 Case "担当出(6)" myColor = 10 '深緑色 myFontColor = 1 Case "売却済" myColor = 16 '濃灰色 myFontColor = 1 Case "廃棄", "修理不可能" myColor = 47 '群青 myFontColor = 2 '白 Case "保守用" myColor = 49 '群青 myFontColor = 2 '白 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = myColor Cells(Target.Row, 1).Resize(1, 28).Font.ColorIndex = myFontColor Application.EnableEvents = True End Sub Private Sub AFall() If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If End Sub

  • 入力数値によってセル色が決まるコードで変更が正しく反映されません

    セルの入力数値によってセルの塗りつぶし色が決まるコードを自作してみました。 0 =< x < 2 : 赤 2 =< x < 4 : 青 4 =< x < 6 : 黄 6 =< x < 8 : 黄緑 8 =< x < 10: ピンク それ以外 : 塗りつぶしなし なんとなくCaseの使い方が正確ではないような気もしますが。。。 ここで困ったことがおきました。手動で数字を入力すると、一応意図したとおりにセルの塗りつぶし色が反映されます。しかし、一旦塗りつぶされたセルの数値を消去しても、塗りつぶしなしとはならずに赤くなってしまいます。 また、対象外のセルから数字を一つコピーして対象セルに貼り付けると、意図したとおりに色が反映されます。しかし、二つ以上のセルをコピーして貼り付けようとすると、実行エラー'13'型が一致しません、というエラーが出てしまいます。 原因が分かりましたらご教示いただけると幸いです。 --- Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column >= 1 And Target.Column <= 10 Then If Target.Row >= 1 And Target.Row <= 10 Then Select Case Target.Value Case 0 To 2 Target.Interior.ColorIndex = 3 Case 2 To 4 Target.Interior.ColorIndex = 5 Case 4 To 6 Target.Interior.ColorIndex = 6 Case 6 To 8 Target.Interior.ColorIndex = 4 Case 8 To 10 Target.Interior.ColorIndex = 7 Case Else Target.Interior.ColorIndex = 2 End Select End If End If End Sub ---

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する