人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【エクセル2003 マクロ】
下記内容のマクロを教えて下さい。添付画像参照。
?シートには保護がかかっています(過去の質問を参考下さい:http://q.hatena.ne.jp/1296553929)
?保護がかかっていますがA列、B列、C1列はロックを外し入力可能な状態です
?A列とC列はリストを使いプルダウンして内容を選択します
?それぞれ100行ほどあり、A1、B1、C1を参照しB3が空白でA10が空白の場合はなどというような参照はしません。
?シートは10枚あり、それぞれをA、B、C・・・とした場合、Eに該当するシートです
?エラーが表示された場合、該当するセルが赤色になる
?エラーが表示されるタイミングはファイルを閉じる時
?A列にはプルダウンして選べる項目がそれぞれ買物・外出・帰宅・遅刻・早退・退職・免職
などの項目があり、このうち買物・外出・帰宅・遅刻を選ぶと今回の内容の対象となるようにしたい。
つまりA列で早退を選ぶとB列・C列が空白であろうとエラーは表示されない。しかし、対象となる4項目
を選ぶとB列・C列を参照しエラーが必要か否かを表示する

コメント欄オープンです
ID:SALINGER
ID:windofjuly

1296786905
●拡大する

●質問者: msvista
●カテゴリ:コンピュータ
✍キーワード:エクセル エラー オープン コメント欄 セル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● うぃんど
●30ポイント

一例

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 If Application.Intersect(Target, Range("A:C")) Is Nothing Then Exit Sub:  'A:C列以外は以降を実行せず処理を抜ける
 
 Dim e As Integer:  'チェックコード
 Dim ec As Integer: 'エラー色
 ec = 3
 
 e = IIf(Cells(Target.Row, 1) = "早退", 1000, 0): 'A列のチェック
 e = e + IIf(Cells(Target.Row, 1) = "", 0, 100): 'A列のチェック
 e = e + IIf(Cells(Target.Row, 2) = "", 0, 10): 'B列のチェック
 e = e + IIf(Cells(Target.Row, 3) = "", 0, 1): 'C列のチェック
 
 Select Case e
 Case 110
 Cells(Target.Row, 4).Value = "担当者を入力してください"
 Range(Cells(Target.Row, 1), Cells(Target.Row, 2)).Interior.ColorIndex = xlNone: '色無し
 Cells(Target.Row, 3).Interior.ColorIndex = ec
 Case 101
 Cells(Target.Row, 4).Value = "業務2を入力してください"
 Cells(Target.Row, 1).Interior.ColorIndex = xlNone: '色無し
 Cells(Target.Row, 2).Interior.ColorIndex = ec
 Cells(Target.Row, 3).Interior.ColorIndex = xlNone: '色無し
 Case 100
 Cells(Target.Row, 4).Value = "業務2と担当者を入力してください"
 Cells(Target.Row, 1).Interior.ColorIndex = xlNone: '色無し
 Range(Cells(Target.Row, 2), Cells(Target.Row, 3)).Interior.ColorIndex = ec
 Case 11
 Cells(Target.Row, 4).Value = "業務1を入力してください"
 Cells(Target.Row, 1).Interior.ColorIndex = ec
 Range(Cells(Target.Row, 2), Cells(Target.Row, 3)).Interior.ColorIndex = xlNone: '色無し
 Case 10
 Cells(Target.Row, 4).Value = "業務1と担当者を入力してください"
 Cells(Target.Row, 1).Interior.ColorIndex = ec
 Cells(Target.Row, 2).Interior.ColorIndex = xlNone: '色無し
 Cells(Target.Row, 3).Interior.ColorIndex = ec
 Case 1
 Cells(Target.Row, 4).Value = "業務1と業務2を入力してください"
 Range(Cells(Target.Row, 1), Cells(Target.Row, 2)).Interior.ColorIndex = ec
 Cells(Target.Row, 3).Interior.ColorIndex = xlNone: '色無し
 Case Else
 Cells(Target.Row, 4).Value = ""
 Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Interior.ColorIndex = xlNone: '色無し
 End Select
End Sub

※偶然見かけたので作ってみましたが、質問文ではIDコール飛ばないようです

◎質問者からの返答

全然、動作しないのですが・・・?

ワークシート名はどこで書き換えればいいのですか?

早退以外はどこに?回答回数を変更しますので再度、お願いします。

ID:windofjuly

ID:SALINGER


2 ● SALINGER
●30ポイント ベストアンサー

こんな感じでどうでしょうか。

図でいくと、7,8,9行目のエラーは起こりえないということになるかと思います。

複数行でのエラーの場合、例えばB3とC4で空白の場合は、「業務2と担当者を入力してください」にしています。

また、見出しの文字を使うようにしています。


Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim i As Integer
 Dim lastRow As Long
 Dim res1 As String
 Dim res2 As String
 
 
 With Worksheets("E")
 lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
 For i = 2 To lastRow
 If .Cells(i, "A").Value = "買物" Or .Cells(i, "A").Value = "外出" Or _
 .Cells(i, "A").Value = "帰宅" Or .Cells(i, "A").Value = "遅刻" Then
 If .Cells(i, "B").Value = "" Then
 res1 = .Cells(1, "B").Value
 .Cells(i, "B").Interior.ColorIndex = 3
 Else
 .Cells(i, "B").Interior.ColorIndex = xlNone
 End If
 If .Cells(i, "C").Value = "" Then
 res2 = .Cells(1, "C").Value
 .Cells(i, "C").Interior.ColorIndex = 3
 Else
 .Cells(i, "C").Interior.ColorIndex = xlNone
 End If
 End If
 Next i
 End With
 
 If res1 <> "" Or res2 <> "" Then
 If res1 <> "" And res2 <> "" Then
 res2 = "と" & res2
 End If
 MsgBox res1 & res2 & "を入力してください", vbExclamation
 Cancel = True
 End If
End Su
◎質問者からの返答

コンパイル 構文エラー

と表示され

Private Sub Workbook_BeforeClose(Cancel As Boolean)

が黄色くなっています

上手く動かないです


3 ● SALINGER
●30ポイント

たぶん、一度赤くなった行を買物・外出・帰宅・遅刻以外にしたときに色を戻す処理が抜けているせいだと思うので1行追加です。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim i As Integer
 Dim lastRow As Long
 Dim res1 As String
 Dim res2 As String
 
 
 With Worksheets("E")
 lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
 For i = 2 To lastRow
 If .Cells(i, "A").Value = "買物" Or .Cells(i, "A").Value = "外出" Or _
 .Cells(i, "A").Value = "帰宅" Or .Cells(i, "A").Value = "遅刻" Then
 If .Cells(i, "B").Value = "" Then
 res1 = .Cells(1, "B").Value
 .Cells(i, "B").Interior.ColorIndex = 3
 Else
 .Cells(i, "B").Interior.ColorIndex = xlNone
 End If
 If .Cells(i, "C").Value = "" Then
 res2 = .Cells(1, "C").Value
 .Cells(i, "C").Interior.ColorIndex = 3
 Else
 .Cells(i, "C").Interior.ColorIndex = xlNone
 End If
 Else
 .Range(Cells(i, "A"), Cells(i, "C")).Interior.ColorIndex = xlNone
 End If
 Next i
 End With
 
 If res1 <> "" Or res2 <> "" Then
 If res1 <> "" And res2 <> "" Then
 res2 = "と" & res2
 End If
 MsgBox res1 & res2 & "を入力してください", vbExclamation
 Cancel = True
 End If
End Sub
◎質問者からの返答

最後にあと一息お願いします。

.Range(Cells(i, "A"), Cells(i, "C")).Interior.ColorIndex = xlNone

恐らく上記はAからCだと思うのですがAとCにするにはどうすれば良いのでしょうか。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ