- ベストアンサー
エクセルVBA/Intersect(Target,～について
end-uの回答
こんにちは。 >If Target.Count >1 then Exit Sub だと、結合セルに名前を定義しているので、一ヶ所だけ選択しても色が変わらなくなります。 >If Selection.Areas.Count >1 then Exit Sub だと、一遍に連続した範囲を選択してもAreasは１ですからだめです。 ここの着眼点は間違ってないですね。 単純にRng(.Cells).Countで判定すれば良いと思います。（縦方向の結合セルにも対応） Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rng As Range With Range("XXX,YYY,ZZZ") .Interior.ColorIndex = xlNone Set Rng = Intersect(Target, .Cells) End With If Not Rng Is Nothing Then If Rng.Count = 1 Then Rng.Interior.ColorIndex = 6 Set Rng = Nothing End If End Sub
関連するQ&A
- エクセルVBAについて
エクセルVBAについて 下にある、1行目に入力された数値の、選択したセルの数値を、Ｂ５セルに表示させるマクロなのですが、1行目が結合していると、うまくＢ５セルに表示できません。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub '●複数セル選択は無視 If Target.Row <> 1 Then Exit Sub '●１行目以外の選択は無視 If Target.Column > 6 Then Exit Sub '●Ｆ列目以降の選択は無視 If Target.Value = "" Then Exit Sub '●選択セルが未入力なら無視 Range("B5").Value = Target.Value End Sub このマクロで、結合しているセルをＢ５に表示させることはできますでしょうか？ 1行目で選択するセルは、すべて2つのセルが結合しています。 よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- エクセル ＶＢＡ セルの色を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の同じセルの色もかわるのでしょうか？ 宜しくお願いいたします
- ベストアンサー
- オフィス系ソフト
- VBA教えてください
VBA初心者です 画像を添付します 赤いセルの背景色に反応し、 C～Eのセルを結合してその中に文字を入れると言うものですが 10/1みたいに全て結合出来れば良いのですが コードを実行した結果 10/5の結果はC～Eのセルは結合されてますが 列の9～11のセルは結合されてないです これをまとめて結合出来るようにしたいです （10/1の結合セルみたいな事をしたいです) コード sub test() const hani as string="A1:Ｅ11" dim rng as range for each rng in range(hani) if rng.interior.colorindex= 3 then range(cells(rng.row,3),cells(rng.row,5)).merge cells(rng.row,3).value="停止" end if next rng end sub です。 試行錯誤しましたが変な結果になって手詰まりしてます。 コード書いてもらえるとすごく助かります！ 回答お願いします！
- ベストアンサー
- Visual Basic
- エクセルVBAのイベントについて教えてください。
エクセルVBA初学者のです。 "C9"にいれるとchangeイベントが発生するコードなんですが、 "C9"のほかに"D1"においてもchangeイベントを発生させたいのですが 下記のコードに続けて書いてもイベントが発生しないのですが どのように書けばよいのでしょうか？ private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("C9")) Is Nothing Then Exit Sub Range("H14:H56").Interior.ColorIndex = 2 If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub Range("G14:G56").Interior.ColorIndex = 2 End Sub よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAのイベントで質問です。
ある範囲のセルの色をダブルクリックにより変えていますが、 下の("D5:D50,F5:F50,K5:K50,M5:M50"))の範囲を例えばSheet1の A2以下に始めの範囲、B2以下に終りの範囲を下に書いていって、 対象とする範囲を可変にしたいのですが、どのようにすれば いいでしょうか。 例えば("D5:D50,F5:F50,K5:K50,M5:M50"))であれば A2に「D5」 B2に「D50」 A3に「F5」 B3に「F50」 などとセルにセル番地をいれておいて、コードを変えなくても シート上で範囲を変えていけるようにできないでしょうか。 やり方があれば教えてください。 よろしくお願いします。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim r As Range Set r = Intersect(Target, Range("D5:D50,F5:F50,K5:K50,M5:M50")) If r Is Nothing Then Exit Sub With r.Interior If .ColorIndex = xlNone Then .ColorIndex = 3 ElseIf .ColorIndex = 3 Then .ColorIndex = 4 ElseIf .ColorIndex = 4 Then .ColorIndex = xlNone End If End With Cancel = True End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル VBA の質問です。
A2～A20までのセルに文字を入力した段階で、それぞれB2～B20に入力日時を入れるVBAを以下のように組んでいます。 しかし、同様の条件を同一シートのE2～E20・F2～F20にも入力・自動表示できるようにしなければならなくなり、困っています。 どのように記述を変えればよいのか、教えていただけたらと思います。 宜しく御願いいたします。 Sub Worksheet_change(ByVal Target As Range) Dim Rng As Range Dim c As Range Set Rng = Range("A2:A20") If Intersect(Target,Rng) Is Nothing Then Exit Sub For Each c In Intersect(Target,Rng) If Not IsEmpty(c) Then c.Offset(, 1).Value = Now Else c.Offset(, 1).ClearContents End If Next Rng.Offset(, 1).EntireColumn.AutoFit End Sub 申し訳ありませんが、何卒、宜しく御願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBAの記録を追加したい
エクセル2002使用です。 VBAで次のコードを使っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Set Target = Intersect(Range("C:C"), Target) If Target Is Nothing Then Exit Sub For Each Rng In Target If Rng.Value <> "" Then Rng.Offset(, -2).Value = Now Else ' (*) Rng.Offset(, -2).Value = "" ' (*) End If Next Rng End Sub （C列のセルに何か入力されると、A列の同じ行にその時刻が入る。） 同じシートで、F列に何か入力されるとE列の同じ行にその時刻が入るように書き直したいのですが、どうすればいいのでしょうか？ すいませんが、よろしくお願いします。
- ベストアンサー
- Visual Basic
- VBA：結合されたセルに対する「Target」について
Private Sub Worksheet_Change(ByVal Target As Range) If Target = "" Then MsgBox "空欄です" End If End Sub 上記コードで、セルにカーソルを合わせてDeleteキーを押すと正常にメッセージが表示されます。 ただし、カーソルを合わせたセルが結合されていた場合、 「型が一致しません」というエラーで停止してしまいます。 結合されているセルに対しても同じ処理をするには、 If Target = "" Then の部分をどのように指定すればよいでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAについて教えてください。
エクセルのVBAについて教えてください。 下記のような構文で、Dの行にAやBの文字が入力された時、その都度 セルの色が変わるようにはできたのですが、本当は、「C5」セルに文字が 入力された時、「C5」だけでなく「B5：J5」の範囲でセルの色を変えたい のですが、どうすれば良いのでしょうか。 ご存知の方是非教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub If Target.Column <>4 Then Exit Sub Select Case Target.Value Case "A" myColor = 34 '水色 Case "B" myColor = 40 '肌色 Case Else myColor = xlNone End Select Target.Interior.ColorIndex = myColor End Sub
- ベストアンサー
- Visual Basic
- VBA 範囲選択時エラー
Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック 「実行時エラー 型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub
- 締切済み
- Visual Basic
お礼
end-uさま、ありがとうございました。 完璧です。助かりました。