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

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2011/02/04 11:35:06
  • 終了:2011/02/04 16:38:36

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692011/02/04 13:03:14

ポイント30pt

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

図でいくと、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
id:msvista

コンパイル 構文エラー

と表示され

Private Sub Workbook_BeforeClose(Cancel As Boolean)

が黄色くなっています

上手く動かないです

2011/02/04 13:13:23

その他の回答(2件)

id:windofjuly No.1

うぃんど回答回数2625ベストアンサー獲得回数11492011/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 = "業務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:msvista

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

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

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

ID:windofjuly

ID:SALINGER

2011/02/04 13:10:34
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692011/02/04 13:03:14ここでベストアンサー

ポイント30pt

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

図でいくと、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
id:msvista

コンパイル 構文エラー

と表示され

Private Sub Workbook_BeforeClose(Cancel As Boolean)

が黄色くなっています

上手く動かないです

2011/02/04 13:13:23
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692011/02/04 14:08:16

ポイント30pt

たぶん、一度赤くなった行を買物・外出・帰宅・遅刻以外にしたときに色を戻す処理が抜けているせいだと思うので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
id:msvista

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

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

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

2011/02/04 14:28:52
  • id:msvista
    IDコールしてますが別に誰でも回答していただいて結構なんですよ。
    嬉しがりで使ってみたかっただけですからw
  • id:SALINGER
    コピペする場所は私の場合、ThisWorkbookのブックモジュールです。
    そこにエラーが出るということは書きこむ場所が違うかと。
    windofjulyさんの回答はシートモジュールです。
  • id:windofjuly
    うぃんど 2011/02/04 13:24:44
    (1)早退以外はどこに?
    e = IIf(Cells(Target.Row, 1) = "早退" Or Cells(Target.Row, 1) = "退職" Or Cells(Target.Row, 1) = "免職", 1000, 0): 'A列のチェック
     
    (2)全然、動作しない
    保存時に一気にチェックするのではなく、その都度出力されるように作りましたので、Worksheet_Change を使っています
    回答1のコードはThisworkbookではなく シートE に貼り付けてください
     
    保存時に一気にチェックということであれば、作り直し(前回のようにループ処理させるだけです)てもよいですが SALINGER さんの回答があるので、もういいですよね?

  • id:SALINGER
    あら、わかりました。コピペしたとき最後にbが抜けてましたw
    End Su

    End Sub
    です。
  • id:msvista
    すみませんちょっと分からないので
    SALINGERさんので出来たのですが、

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

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

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

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

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

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

    SALINGER へ
    .Cells(Rows.Count, "A").End(xlUp).Row より .Cells.SpecialCells(xlLastCell).Row のほうが安全のような気がします
    (最終行のA列が空でB列やC列にデータが入っている時に…)
  • id:windofjuly
    うぃんど 2011/02/04 14:08:43
    ごめんなさい敬称ぬけました > SALINGER さん
    IDコールがなくとも回答者にはコメント通知メールが届きますので、コメント欄に何か書き込めばよいです > msvista さん
     
    では…
  • id:SALINGER
    最終行のA列が空白の場合はエラーを出す必要が無いという考えで前者を選択しましたが、
    買物・外出・帰宅・遅刻以外の場合は、色を戻す処理が必要であるようですので、7行目を
    lastRow = .Cells(Rows.Count, "A").End(xlUp).Row

    lastRow = .UsedRange.Rows.Count
    に変えておいてください。
  • id:SALINGER
    今度は追加したコードにコンマが抜けてた。なんかボロボロだなw
  • id:SALINGER
    すいません。最終的にこちらで
    http://d.hatena.ne.jp/SALINGER/20110204
  • id:msvista
    >さすがに3度目の正直で懲りましたので

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

    では・・・
  • id:SALINGER
    >恐らく上記はAからCだと思うのですがAとCにするにはどうすれば良いのでしょうか。
    .Cells(i, "A").Interior.ColorIndex = xlNone
    .Cells(i, "C").Interior.ColorIndex = xlNone
    のように2行にするか、1行でやるなら
    .Range("A" & i & "," & "C" & i).Interior.ColorIndex = xlNone
  • id:msvista
    依頼したい内容の詳細を書くポイントをご教示下さい。

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

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

    皆さんに一回でできるだけ済ませられるように質問者である私もきちんと質問分を
    考えたいと思います。
  • id:sayo213sayo
    コメント荒らし キタ━━(━(━(-( ( (゚∀゚) ) )-)━)━) ━━ !!!!!
     
    大御所を出し抜こうと慌てて回答ww
    敬称を抜かしたことに平謝りwww
  • id:SALINGER
    前回の質問があったのでやりたいことはわかりやすかったですけど。
    そもそもわからないことを言葉にして伝えるのって難しいので、
    言葉だけじゃなく図を見せれば一発っていうのはありますね。
     
    他のひどい質問だと、曖昧な質問にコメント欄もオープンしてなくて、
    回答者は質問者が求める答えを予想して回答するみたいな質問もありますよw
  • id:SALINGER
    >sayo213sayo
    人を攻撃するために、VBAしか知らない人間を大御所呼ばわりするのは虫唾が走るね。
  • id:windofjuly
    うぃんど 2011/02/04 15:38:11
    「あ、ここも!」「あ、このアイデアいいなー」で増築に改築を重ねたものは後々、どうしようもなくなります
    前回はA列とB列で、今回はC列とD列が加わりました
    最初からC列があるものを提示していれば、前回だけで終了したということになりますよね。 もしくは前々回だけで終了したかもしれません

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

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

    前回、今回の内容を踏まえ最終形の質問をしたいと思います。
    その際は、よろしくお願い致します。
  • id:sayo213sayo
    コメント荒らし再び キタ━━(━(━(-( ( (゚∀゚) ) )-)━)━) ━━ !!!!!
     
    イルカ賞はもらえなかったねwww

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません