【エクセル2003　マクロ】

Question

msvista

23

18もっと見る

90pt

コンピュータ

【エクセル2003　マクロ】

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

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

回答の条件

1人2回まで

登録：2011/02/04 11:35:06
終了：2011/02/04 16:38:36

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.1

うぃんど262511492011/02/04 13:01:11

30pt

一例

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 = "業務２を入力してください"
        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 = "業務２と担当者を入力してください"
        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 = "業務１を入力してください"
        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 = "業務１と担当者を入力してください"
        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 = "業務１と業務２を入力してください"
        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

2011/02/04 13:10:34

No.3

SALINGER34549692011/02/04 14:08:16

30pt

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

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にするにはどうすれば良いのでしょうか。

2011/02/04 14:28:52

msvista 2011/02/04 13:19:48

IDコールしてますが別に誰でも回答していただいて結構なんですよ。
嬉しがりで使ってみたかっただけですからｗ
SALINGER 2011/02/04 13:21:02

コピペする場所は私の場合、ThisWorkbookのブックモジュールです。
そこにエラーが出るということは書きこむ場所が違うかと。
windofjulyさんの回答はシートモジュールです。
うぃんど 2011/02/04 13:24:44

（１）早退以外はどこに？
e = IIf(Cells(Target.Row, 1) = "早退" Or Cells(Target.Row, 1) = "退職" Or Cells(Target.Row, 1) = "免職", 1000, 0): 'A列のチェック
　
（２）全然、動作しない
保存時に一気にチェックするのではなく、その都度出力されるように作りましたので、Worksheet_Change を使っています
回答１のコードはThisworkbookではなくシートE に貼り付けてください
　
保存時に一気にチェックということであれば、作り直し（前回のようにループ処理させるだけです）てもよいですが SALINGER さんの回答があるので、もういいですよね？
SALINGER 2011/02/04 13:41:31

あら、わかりました。コピペしたとき最後にbが抜けてましたｗ
End Su
↓
End Sub
です。
msvista 2011/02/04 13:48:04

すみませんちょっと分からないので
SALINGERさんので出来たのですが、

1.前はちゃんと入力しないとファイルが閉じれなかったのに今回はエラー箇所を
　入力しなくても閉じれてしまう。ちゃんと入力しないと閉じれないようにしたい。

2.未入力箇所が赤くはなるのですがエラーメッセージがでない。せめて「未入力箇所を入力して下さい」
　でもいいので表示させたい

3.買物・外出・帰宅・遅刻以外を選択しても赤くなります。この文言以外は参照しない、
　といいますかエラーにならないようにしたいのです

よろしくお願い致します。

ID：windofjuly
まだまだ質問がありますので、懲りずにお願いします。頼りにしています。
うぃんど 2011/02/04 14:03:22

msvista さんへ

保存しようとするときに一気にチェックも良いですが「急いでいるので、とりあえず保存して電源切りたい」というような場合にもチェックエラーが吐き出され続けるということにもなりかねないので、今回は入力された時点で即座に変わるように作りました
保存するときにも警告メッセージを出したいのであれば「Ｄ列が空っぽであるかどうか？」だけをチェックしてメッセージを出すようにすればよいので、機能を分けることができ、デバッグも簡単になりますし、応用も利くでしょう
前回、背景色を変えるように入れてあったのも今後のための布石であったりしたわけですが、最終的にどのようなものを求めているかを今一度考えてみてくださいね（今後のコード作成のためのヒントはそこここに入れてあります）
さすがに３度目の正直で懲りましたので、お望みの作業が滞りなく終了することを願って、ひとまず失礼したいと思います（回答１のコードミス以外での対応はいたしかねますのでIDコールしないでください）

SALINGER へ
.Cells(Rows.Count, "A").End(xlUp).Row より .Cells.SpecialCells(xlLastCell).Row のほうが安全のような気がします
（最終行のA列が空でB列やC列にデータが入っている時に…）
うぃんど 2011/02/04 14:08:43

ごめんなさい敬称ぬけました　＞　SALINGER さん
IDコールがなくとも回答者にはコメント通知メールが届きますので、コメント欄に何か書き込めばよいです　＞　msvista さん
　
では…
SALINGER 2011/02/04 14:18:43

最終行のA列が空白の場合はエラーを出す必要が無いという考えで前者を選択しましたが、
買物・外出・帰宅・遅刻以外の場合は、色を戻す処理が必要であるようですので、７行目を
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
↓
lastRow = .UsedRange.Rows.Count
に変えておいてください。
SALINGER 2011/02/04 14:24:12

今度は追加したコードにコンマが抜けてた。なんかボロボロだなｗ
SALINGER 2011/02/04 14:30:06

すいません。最終的にこちらで
http://d.hatena.ne.jp/SALINGER/20110204
msvista 2011/02/04 14:31:06

>さすがに３度目の正直で懲りましたので

うっ。。。すみません。。。
最後にお願いした内容で閉めたいと思います。

では・・・
SALINGER 2011/02/04 14:38:51

＞恐らく上記はAからCだと思うのですがAとCにするにはどうすれば良いのでしょうか。
.Cells(i, "A").Interior.ColorIndex = xlNone
.Cells(i, "C").Interior.ColorIndex = xlNone
のように２行にするか、１行でやるなら
.Range("A" & i & "," & "C" & i).Interior.ColorIndex = xlNone
msvista 2011/02/04 14:58:11

依頼したい内容の詳細を書くポイントをご教示下さい。

>最終的にどのようなものを求めているかを今一度考えてみてくださいね

これがひっかかってます。
自分の頭の中である程度、出来上がっているのですが実際に走らせると
「あ、ここも！」「あ、このアイデアいいなー」となります。
特にエラーセルに色を付けるとか未入力が終わるまでファイルが閉じれないようにするなどです。

皆さんに一回でできるだけ済ませられるように質問者である私もきちんと質問分を
考えたいと思います。
sayo213sayo 2011/02/04 15:03:07

コメント荒らしｷﾀ━━(━(━(-( ( (ﾟ∀ﾟ) ) )-)━)━) ━━ !!!!!
　
大御所を出し抜こうと慌てて回答ｗｗ
敬称を抜かしたことに平謝りｗｗｗ
SALINGER 2011/02/04 15:08:31

前回の質問があったのでやりたいことはわかりやすかったですけど。
そもそもわからないことを言葉にして伝えるのって難しいので、
言葉だけじゃなく図を見せれば一発っていうのはありますね。
　
他のひどい質問だと、曖昧な質問にコメント欄もオープンしてなくて、
回答者は質問者が求める答えを予想して回答するみたいな質問もありますよｗ
SALINGER 2011/02/04 15:29:58

＞sayo213sayo
人を攻撃するために、VBAしか知らない人間を大御所呼ばわりするのは虫唾が走るね。
うぃんど 2011/02/04 15:38:11

「あ、ここも！」「あ、このアイデアいいなー」で増築に改築を重ねたものは後々、どうしようもなくなります
前回はＡ列とＢ列で、今回はＣ列とＤ列が加わりました
最初からＣ列があるものを提示していれば、前回だけで終了したということになりますよね。　もしくは前々回だけで終了したかもしれません

PLAN-DO-SEEに置きますと以下のような具合です
（PLAN）１つの方法としては「Excelを使わず紙の上で行うとすれば、どのような項目を用意して、どのように並べるかを先に考えてみる」と良いでしょう
（DO）次に、他の人はExcelで入力チェックをどのようにやっているのかを調べてみると良いでしょう
（SEE）簡単に実現できそうなことは実装し、ちょっと面倒そうな場合は（PLAN）に立ち返る

上記のように行いますと、私の今回の回答にしても、実はVBAで行う必要すらなかったりすることにも気づかれることでしょう
マクロでという質問だったのでマクロにしましたが、Excelの条件付書式でも背景色を変えるようなことくらいできますし、Ｄ列もワークシート関数を使えば良いだけです
エラーがあったら閉じさせないという以前に、その場でチェックが済んでしまうということになり、マクロの出番はなくても良くなります（２重の防止線としてマクロでのチェックを併用するというのは「アリ」です）
　
以上、少しでもお役に立てば…
msvista 2011/02/04 16:21:02

SALINGERさん、windofjulyさん
色々とありがとうございました。

前回、今回の内容を踏まえ最終形の質問をしたいと思います。
その際は、よろしくお願い致します。
sayo213sayo 2011/02/04 18:26:31

コメント荒らし再びｷﾀ━━(━(━(-( ( (ﾟ∀ﾟ) ) )-)━)━) ━━ !!!!!
　
イルカ賞はもらえなかったねｗｗｗ

人力検索はてなはてなのIDコールのことがよくわかりません.. 2011-04-17 11:06:45

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

SALINGER · Accepted Answer · 2011-02-04T13:03:14+09:00

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

図でいくと、７，８，９行目のエラーは起こりえないということになるかと思います。

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

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

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

SALINGER · Accepted Answer · 2011-02-04T13:03:14+09:00

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

図でいくと、７，８，９行目のエラーは起こりえないということになるかと思います。

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

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

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

【エクセル2003　マクロ】

ベストアンサー

SALINGER34549692011/02/04 13:03:14

その他の回答（2件）

うぃんど262511492011/02/04 13:01:11

SALINGER34549692011/02/04 13:03:14ここでベストアンサー

SALINGER34549692011/02/04 14:08:16

コメント（19件)

この質問への反応（ブックマークコメント）

トラックバック

【エクセル2003 マクロ】

ベストアンサー

SALINGER34549692011/02/04 13:03:14

その他の回答（2件）

うぃんど262511492011/02/04 13:01:11

SALINGER34549692011/02/04 13:03:14ここでベストアンサー

SALINGER34549692011/02/04 14:08:16

コメント（19件)

この質問への反応（ブックマークコメント）

トラックバック

【エクセル2003　マクロ】