VBAでセルの色付を別の列にも追加する方法は？| OKWAVE

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 御指導よろしく御願いします。

D2に入力、B2に今日の日付のVBAを追加したいが

いつもお世話になります。 WINDOWS7 EXCELL2010 です。ご指導を仰ぎたいのは、 D2に顧客名(参照図では　田中) と入力したら　B2に　今日の日付(2013/06/14)としたい。追加する前のVBAは下記です。 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 上のマクロに下記のマクロを追加すると参照図のようなエラーが表示されます。下記のマクロの何かが間違っていると考えています。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("D2:D100")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub ご指導いただけるとうれしいです。

日付を入力すると何故か今日の日付に

いつもお世話になります。 WINDOWS7 EXCELL2010 です。参照図で言うと、 B2 に例えば　1/4　と入力すると　今日の日付になります。何故なんでしょうか。影響しているのかどうかわかりませんが参考に下記のようなコードを使用しています。 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

VBAで作業を作成したものを別の列に適用するには

教えてください。マクロ初心者ですが、色々なところから検索してI列に文字が入力されるとJ列に自動で明日の日付が入るようにまた、入力したIとJのセルを色つけまで完成させました。次の列以降にも同じ作業を行いたいときのVBAを教えてください。（「KとL」「MとN」に同じ処理をしたい場合）ループ処理など見たのですが、行のようでよくわかりませんでした。ちなみに作成したVBAがこちらです。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If Application.Intersect(Range("I1:I100"), Target) Is Nothing Then Exit Sub If .Count > 1 Then Exit Sub If IsEmpty(.Value) Then .Offset(, 1).ClearContents Else .Offset(, 1).Value = Date+1 End If End With Dim myColor As Variant Dim c As Range Dim myRng As Range Set myRng = Application.Intersect(Range("I:I"), Target) If myRng Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In myRng Select Case c.Value Case 1 myColor = 36 Case 2 myColor = 38 Case 3 myColor = 40 Case 4 myColor = 39 Case 5 myColor = 34 Case 6 myColor = 35 Case Else myColor = xlNone End Select Cells(c.Row, 9).Resize(1, 2).Interior.ColorIndex = myColor Next c 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で作業をしております。なかなかうまくいかずで困ってしまっております。下記のような関数でシート一枚は出来たのですが、それ以外のシートには反映がされません。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range If Application.Intersect(Target, Range("A2:A10000")) Is Nothing Then Exit Sub For Each r In Target If r.Column = 1 Then Select Case r.Value Case "○": r.Resize(1, 12).Interior.ColorIndex = 19 Case "×": r.Resize(1, 12).Interior.ColorIndex = 3 Case "△": r.Resize(1, 12).Interior.ColorIndex = 6 Case Else: r.Resize(1, 12).Interior.ColorIndex = xlNone End Select End If Next r End Sub 無知なので、ネットで調べて上記のような数式を拾ってきたのですが、どうやら1シート分の設定に書かれているようです。。。全シートに反映がされるように設定をするにはどこをどのように書き換えればよろしいでしょうか。お分かりの方がいらっしゃいましたら、よろしくお願いいたします。

別の列のデータを検索してセルの色を変える

Private Sub Worksheet_Change(ByVal Target As Range) If (Target.Column <> 1) And (Target.Column <> 5) Then Exit Sub If Not IsNumeric(Target.Value) Then Exit Sub Target.Offset(0, 1).Value = Now() End Sub 上記のスクリプトで「１列目にナンバーを記入すると２列目に、５列目にナンバーを記入すると６列目に時刻が自動的にセルに入る」ようになっています。これに追加で「５列目にナンバーが記入されると、そのナンバーと同じものを１列目から探し出して、１列目のセルの色を薄い青にする。なければなしとアラートを出す」ように改造したいのですがどうすればいいでしょうか？どうかお願いいたします。

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

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列の同じ行にその時刻が入るように書き直したいのですが、どうすればいいのでしょうか？すいませんが、よろしくお願いします。

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

以下のような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

空白セルと０値を識別させたい。（VBA）

すみません、誰か教えていただけますか。シートの53、54、55行目にそれぞれ値入っています。それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が続く部分の合計を出しています。しかし、下記の記述ですと数値が0（変数D=0）の時にうまくいきません。空白セルと認識されてしまうと思います。何か、良い方法があれば教えて頂けませんでしょうか。宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub

【VBA】クリックする毎にセル色が変わる

Excelのセルをクリックするたびに、「色なし→赤→青→黄→黒→色なし」などのように色を順番に変更する方法があれば教えてください。下記のSelectionChangeコードで、「色なし→黄→色なし」にできるのですが、複数の色を順番に表示させたいと思っております。お手数お掛けいたしますが、よろしくお願い致します。 ================================================= Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim 各セル As Range Set Target = Intersect(Target, Range("A1:A5")) If Target Is Nothing Then Exit Sub For Each 各セル In Target With 各セル If .Value = 1 Then .ClearContents .Interior.Pattern = xlPatternNone Else .Value = 1 .Font.ColorIndex = 6 .Interior.ColorIndex = 6 End If End With Next End Sub =================================================

エクセルの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

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で指定したセルへジャンプするコード(追加の追加質問です)

http://oshiete1.goo.ne.jp/qa2903797.html たびたびすみません。最後にひとつだけお願いします。お教えいただいた下のコードは順調に動作するのですが、対象セルが結合セルの場合、エラーが出てしまいます。とまってしまうコードの部分は With Selection.AddComment です。エラーメッセージにはプロシージャの呼び出し、または引数が不正です。(Error 5)と書いてあります。結合セルは動作しないものでしょうか？ Sub test01() Dim x As String Dim ThisSheet_Name As String Dim Sheet_Name As String Dim Range_Name As String Dim I As Integer, n As Integer Dim Ans As Integer Dim myComment As String '新規追加 Dim Colors As Integer '新規追加 ThisSheet_Name = ActiveSheet.Name '設定シート Select Case Workbooks.Count Case 1 MsgBox "チェックするファイルがありません。" Exit Sub Case 2 For n = 1 To 2 If Workbooks(n).Name <> ThisWorkbook.Name Then x = Workbooks(n).Name '開いている“もうひとつのブック”の名前 End If Next Case Else MsgBox "他に開いているファイルが複数のため対象を特定できません。" Exit Sub End Select I = 0 Do While (1) With ThisWorkbook.Sheets(ThisSheet_Name) If .Range("A3").Offset(I, 0).Value = "" Then MsgBox "検査項目は以上です。" ThisWorkbook.Activate Exit Do 'A列の３行目以下が、空白なら終わる End If Sheet_Name = .Range("A3").Offset(I, 0).Value Range_Name = .Range("B3").Offset(I, 0).Value myComment = .Range("C3").Offset(I, 0).Value End With Windows(x).Activate Sheets(Sheet_Name).Select Range(Range_Name).Select Colors = Selection.Interior.ColorIndex '新規追加 Selection.Interior.ColorIndex = 6 With Selection.AddComment .Visible = True .Text myComment End With Range(Range_Name).Select Ans = MsgBox("「次をチェックしますか？」", vbYesNo) Selection.Interior.ColorIndex = Colors '修正 Selection.ClearComments '新規追加 If Ans = vbYes Then I = I + 1 Else Exit Do End If Loop End Sub

このVBAソースのどこが間違ってるか教えてください

Dim csp As Integer 'ストップ Dim css As Integer 'ストップorスタート Sub Quest2() If css = 0 Then css = 1 Quest2a Else cstp = 1 css = 0 End If End Sub Sub Quest2a() Sheets("Sheet1").Select Range("B1:J10").Select Selection.Interior.ColorIndex = x1None Range("a1").Select cstp = 0 Do r = 1: c = 5 For i = 0 To 15 If i < 9 Then Cells(r, c).Interior.ColorIndex = x1None r = r + 1 If i < 5 Then c = c + 1 Else c = c - 1 End If Cells(r, c).Interior.ColorIndex = 3 Else Cells(r, c).Interior.ColorIndex = x1None r = r - 1 If i < 13 Then c = c - 1 Else c = c + 1 End If Cells().Interior.ColorIndex = 3 End If 'タイミング For tm1 = 1 To 1000: For tm2 = 1 To 100: Next If cstp = 1 Then Exit For End If Next DoEvents If cstp = 1 Then Exit For End If If r = 3 And c = 5 Then Cells(r, c).Interior.ColorIndex = x1None End If Next DoEvents If cstp = 1 Then Exit Do End If Loop Cells(10, 9) = Cells(r, c) Cells(10, 9).Interior.ColorIndex = 8 End Sub

数値の入ったセルの色分け

エクセル（2003）で数値の入ったセルを色分けしたいです。色んなサイトを見て下記を書いてみましたが数値を入力すると色が変わるのですが別のところから数値をコピーペーストすると色が変わりません。マクロでもVBAでもなんでもかまいません。数値を5種類に分けてセルの色を変える方法を教えていただきたいです。宜しくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myNO As Integer With Target If .Count > 1 Then Exit Sub If IsEmpty(.Value) Then Exit Sub If Not Application.Intersect(Target, Range("A1:AX51")) Is Nothing Then Select Case .Value Case Is <= 54: myNO = 3 Case 55 To 79: myNO = 39 Case 80 To 104: myNO = 4 Case 105 To 119: myNO = 33 Case Is >= 120: myNO = 6 End Select .Interior.ColorIndex = myNO End If End With 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 ---

テキストボックスの色変更

自動でテクストボックスの色変更をしたいのですが、前回こちらにて質問をさせていただき大変助かったのですが、さらに、問題に突き当たりました。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("R8: S341 ")) Is Nothing Then Exit Sub If Cells(Target.Row, "R").Value < -10 Then c = 10 Else Select Case Cells(Target.Row, "S").Value Case Is > -89 c = 17 Case Is < -100 c = 10 Case Else c = 12 End Select End If With Sheets("sheets2").Shapes("テキスト " & Target.Row) .Line.ForeColor.SchemeColor = c .TextFrame.Characters.Font.ColorIndex = c - 7 End With End Sub にて、色と文字色の変更はできたのですが、Ｒ列、Ｓ列を関数で読み込んでくると自動では変わりません。手動で打ち込むと変わるのですが一緒に文字サイズの指定もできるのでしょうか？宜しくお願いいたします。

excel BVでTarget.Offset

勤務表を作成しています。勤務「Ｃ」の翌日は「休」にするところまでは出来たのですが、「Ｃ」が連続する日は「休」も連続させたいのです。例）３日と４日が「Ｃ」の時は、５日、６日は連休にしたいのですが、作った下のマクロでは７日も「休」になってしまいます。何が間違ってるんでしょうか？。 If Target.Count > 1 Then Exit Subの意味も良く解っていませんが…。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Value = "Ｃ" Then Target.Offset(0, 1).Value = ("休") End If If Target.Offset(0, -2).Value = "Ｃ" Then Target.Offset(0, 1).Value = ("休") End If End Sub

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

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

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

補足 2011/05/24 21:14

その他の回答 (1)

お礼 2011/05/25 00:10

関連するQ&A