[[20110321134155]] 『マクロで勤務表』(ふわり) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『マクロで勤務表』(ふわり)

Excel2003 WindowsXPを使用してます。

 たとえばK10のセルに○を入力すると
E10に8:30 H10に17:15と自動で入力出来たりまたL10に○を入力するとE10に17:00 H10に1:45と自動で入力出来たり

といったようなマクロは組めるのでしょうか?
誰かわかるかた教えてください。


 組めるかといえば組めますが、ご自身で理解する努力は必要です。

 一応たたき台です。
 Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns("K:L")) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    For Each r In Intersect(Target, Columns("K:L"))
        If r.Value = "○" Then
            Select Case r.Column
                Case Range("K1").Column
                    Cells(r.Row, "E").Value = "8:30:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                Case Range("L1").Column
                    Cells(r.Row, "E").Value = "17:00:00"
                    Cells(r.Row, "H").Value = "1:45:00"
            End Select
        End If
    Next
    Application.EnableEvents = True
 End Sub
 (Mook)

完璧に出来ました。ありがとうございました。


○では出来たのですが、○と1と2を入れた場合とか複数の場合は可能なんでしょうか?
Mの列に1を入力するとE=8:30F=17:15と入力でき2と入力するとE=17:00F=1:45としたいのですが。。。
不可能でしょうか?

 前回提示した内容を理解できれば、今回の要望はご自身で変更できると思います。

    Dim r As Range
    For Each r In Target
        If r.Column = 13 Then ' M列なら
            Select Case r.Value
                Case 1
                    Cells(r.Row, "E").Value = "8:30:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                Case 2
                    Cells(r.Row, "E").Value = "17:00:00"
                    Cells(r.Row, "H").Value = "1:45:00"
            End Select
        End If
    Next

 前回の内容と今回の内容を比較し、それぞれの行が何をしているかを是非理解下さい。
 簡単な部分だけでも覚えると、ずいぶん応用範囲が広がりますよ。
 (Mook)

 ずいぶん考えたのですがまだまだ理解が出来ないようです。
 もう一度質問させていただきます。
 少し変わったので、

    F    H     K    L    M    N    O
             1直             2直     変2直     3直
 10 8:30   17:15   ○
 11 9:00   17:15   ●
 12  9:00   15:00      ◆	
 13 17:00  1:45		    ○
 14 19:00  3:45                 ○
 15 1:00   9:00                      ○

 と上記のマクロを自分ながらにしてみましたが動かなくなったりと悪戦苦闘して
 しまいました。関数でもアドバイスをいただきやってましたがやはりマクロで
 の実行の方が望ましいと思いまして。。。
 マクロ初心者にはお手上げです。
 ご伝授願います。


 まずは、Mookさんの二番目のコードに倣って
 やりたい事を文章にしてみたらどうですか?

 例
  入力が有ったセルの
    列番号が 11 の場合(A列が1番なので、11番とは、K列の事です。)
         セルの値が ○ なら
         同じ行のF列のセルに 8:30
                 同じ行のH列のセルに 17:15
           セルの値が ● なら
         同じ行のF列のセルに 9:00
                 同じ行のH列のセルに 17:15
            :
            :
    列番号が 13 の場合
            :
            :

 と言った感じで。

 (HANA)

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns("K:O")) Is Nothing Then Exit Sub

 Dim r As Range
    For Each r In Target
        If r.Column = 11 Then ' K列なら
            Select Case r.Value
                Case ○
                    Cells(r.Row, "F").Value = "8:30:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                Case ●
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                Case ◆
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                   End Select
        End If
    Next

    Dim s As Range
    For Each s In Target
        If s.Column = 13 Then ' M列なら
            Select Case s.Value
                Case ○
                    Cells(s.Row, "F").Value = "17:00:00"
                    Cells(s.Row, "H").Value = "1:45:00"
                     End Select
        End If
    Next

    Dim t As Range
    For Each t In Target
        If t.Column = 14 Then ' N列なら
            Select Case t.Value
                Case ○
                    Cells(t.Row, "F").Value = "19:00:00"
                    Cells(t.Row, "H").Value = "3:45:00"
            End Select
        End If
    Next

    Dim u As Range
    For Each u In Target

        If u.Column = 15 Then ' O列なら
            Select Case u.Value
                Case ○
                    Cells(u.Row, "F").Value = "1:00:00"
                    Cells(u.Row, "H").Value = "9:00:00"

            End Select
        End If
    Next
 Application.EnableEvents = True
 End Sub
 これではマクロ起動しませんよね。
 マクロ素人すぎました。
 ご伝授ください


 エクセルは なんだかよく分からない物(文字列) が出てきたら
 「う〜ん、わかんないけど 変数なんだろうね」
 と思ってくれます。

 今回の場合の、エクセルにとってなんだかよく分からない物 は
 ○,●,◆ です。

 「○と言う文字列」を意味したいなら "○" と書かなきゃいけません。
 今は単に ○ だけなので、○と言う変数の中に入っている物(勿論何も入っていない)
 と一致する値かどうかを確認しているので、全て通り過ぎて仕舞います。

 こういったミスを無くす為にも、変数の宣言は強制にしておきましょう。
 コードを書いている白い部分の一番先頭に
  Option Explicit
 を入れてみて下さい。

 セルに変化があって、マクロが実行されると
  コンパイルエラー:変数が定義されていません。
 のメッセージボックスが表示され、まず ○ 部分が反転します。
 すると、「違うんだよ〜、変数のつもりじゃなかったんだよ〜〜」なんて
 エクセル君と認識のすりあわせが出来る様に成ると思います。

 VBEのツール(T)→オプション(O) [編集]タブの
  ■変数の宣言を強制する(R)
 にチェックを入れておくと、勝手に入るので便利だと思います。

 それぞれの文字は "" で囲って貰うとして、
                Case "◆"
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "17:15:00"
 ここは、H列に入れる時間が違っている様ですね?

 それから、最後に
 Application.EnableEvents = True
 があるけど、最初に(Exit Subの後に)False が無いみたいです。

 結果はそれで出ると思いますが。。。。

    Dim r As Range
    For Each r In Target
        If r.Column = 11 Then ' K列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "8:30:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                Case "●"
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                Case "◆"
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "17:15:00"
            End Select
        End If

        If r.Column = 13 Then ' M列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "17:00:00"
                    Cells(r.Row, "H").Value = "1:45:00"
            End Select
        End If

        If r.Column = 14 Then ' N列なら
          :
          :
    Next
 Application.EnableEvents = True
 End Sub
     
 の様にしておくと、ループ回数が減らせそうです。

 やってみて下さい。

 (HANA)


 わーーーー出来ました。それと少しマクロがわかってきました。まだまだですけど。。。
 ありがとうございました。

 上記のマクロをThisWorkbookに移動するとまた条件が変わるんですよね?
 他の方のエクセルの質問で出てたので私もシートに書き込んでてたくさんのシートがあるので
 出来たら便利だなと思いまして。。。
 すいません。

 まずはそのページに書いてある様にやってみましたか?
 出来なかったら
  どの様な操作をしたか
  現在コードはどの様に成っているのか
  どの様な希望しない結果になるのか
 を、こちらが分かるように書いて下さい。

 ↓の事だと思いますが。。。
[[20110909060457]] 『コードのマクロ』(くろん)
 他の人とのやりとりですが、自分が同じ質問をして自分が答えて貰っていると思って
 良く読んで、同じ所・違う所 を見極め、ふわりさんの状況に合うようにしてみて下さい。

 VBEのコードを書く部分のすぐ上に ドロップダウンが二つあると思います。
 今書いているシートモジュールの項目(左側で「Worksheet」を選んだ時の右側)と
 ThisWorkbookモジュールの項目(左側で「Workbook」を選んだ時の右側)も付き合わせてみて下さい。
 違う所を見極めるヒントになると思います。

 「強制終了上等!!」で、まずは色々やってみるのが良いと思います。
   闇雲にやったのでは何にも成りませんけど。。。
   上手く行かなかったら、見極めた「同じと思う所・違うと思う所」も
   一緒に教えてもらえると良いかもしれません。

 (HANA)

 移動させていただきました。

 >個別勤務表は10行目が16日ですが、このシートは 9行目が16日ですか?
 勤務データは9行目です。

 >日々勤務表 から、対応する個別勤務表用のデータを集めて来る&集計する
 >ってのは、これで完成ですか?
 31行34列の枠転記OKで41行42行の集計もOKです。
 かつ勤務データからの
 >For i = 1 To 31
            >If ws1.Range("J" & i + 8).Value <> "" Then
                >With Sheets(Format(ws1.Range("J" & i + 8).Value, "d日"))
 の部分も完成しました。

  数式の件ですが時給者の日勤者のみ数式を入れる形に現在はしてあります。
 いろいろ試行錯誤したみたいですが、半日年休を使用した場合にF列の始業時間とH列の終業時間は
 実際働いた時間を記入し労働時間のAA列は所定労働時間を記入するという複雑な事もあります。
 例)2直や3直
 行 __F_  _H_   _K_ __M__ _N_ __ _O ____ W  ___AA_ ___AB__ __AD_ __AF _ 
   8  始業   終業   1直  2直  変2直  3直   年休  通常   早残  深夜  遅早私    
  11 21:30   1:45         ○                前  4.00   0.00  3.75        
  12  5:45  10:00                     ○     前  4.25    1.00  4.00  

 といった稀ですがありますので2直3直変2直の方は担当者が時間などは入力するように
 話し合いの結果なったようなので実際はAA101:AB155のみ数式が入ってます。  

 AA101=IF(F101="","",MIN(7.75,((H101-F101)*24)-IF(H101>0.5,AY101,0)))
 AB101=IF(F101="","",IF(((H101-F101)*24)-AY101>AA101,(((H101-F101)*24)-AA101)-AY101,""))
 といった感じです。

 [日々勤務表]
   行 __F_  _H_   _K_ __M__ _N_ ___O ____ _AA_ ___AB__ __AD_ __AF _ 
   8  始業    終業    1直  2直  変2直 3直    通常   早残  深夜  遅早私    
   11 8:30   17:15   ○                  7.75
  12 8:30   18:15   ○                  7.75  1.00   
 となってます。

 >先に 個別勤務表の数式のマクロ化を考えてみてはどうでしょう。
 というのは↑をマクロ化ですか?
 それとも個人勤務表のB列の日付のところをマクロ化。。。

 >Sheet1からSheet2に関数で振り分けて
 >それを個人シートに関数で参照して
 >日付部分も関数で参照してますよね?

 >この作業はご自身の意志で実行すれば良いと思いますので
 >これを、ボタンで実行するマクロに変えてはどうでしょう。
 >関数部分が減らせると思います。
 ということは日付ですの部分を説明せさせいただきます。

 sheet2のN11列に勤務データで作成してた日付振り分け項目があります。
 勤務データのE列は通常勤務者
 勤務データのH列は検査勤務者
 勤務データのM列はA班勤務者
 勤務データのO列はB班勤務者
 勤務データのQ列はC班勤務者
 勤務データのS列はD班勤務者
 で、↓の式を個人勤務表のB列に入れてあります。

 B10=HLOOKUP(sheet2!$N$11,勤務データ!$E$8:$AJ$41,ROW(勤務データ!$E$2),FALSE)

 説明がずれてたらすみません。。。
(4949)


 まず最初に↓でも書きましたが。。。
[[20110916103750]] 『マクロ四角形』(4949)

 >>先に 個別勤務表の数式のマクロ化を考えてみてはどうでしょう。
 ってのは、表の名前が間違いで「日々勤務表(このスレで扱っているシート)」
 のつもりで書いていましたので、こちらのスレに移動を考えました。

 >実際はAA101:AB155のみ数式が入ってます。
 と言う事は
[[20110808104507]] 『エクセルで勤務表作成』(もこもこ)
 のスレのレイアウトは↓でしたが
 __Y__ __Z__ _AA_ __AB__ _AC_ _AI_ _ AJ _ __AK__ __AL__ __AM__ __AN__
 通常  早残       深夜             休始   休終   実働   実休   既定  
 この時の数式も入っていないと言う事ですか?
 或いは、違うシート?

 一旦、このシートの全体像(8行目の見出し)を教えて貰って良いですか? 

 (HANA)

 [日々勤務表]
    行   __F_  _H_   _K_ _ _L   M__ _N_ ___O __ P  Q   R  S 

      始業    終業    1直  時差 2直  変2直 3直 空白 遅早私 連操	呼出 

      T    U  V  W  X  Y  Z__    AA____AB____AD_ __AF _  

      休出 代休 公休 年休 欠勤 休業 教育訓練  通常  早残  深夜  遅早私

      AH     AJ      AL  AN  

      休出   法定休出 代休  法定代休

 実際はAA101:AB155の時給者かつ日勤者のみしか数式は入っていないです。
 せっかく半平太さんにいただいたものなのですが			
 いろいろ試行錯誤したみたいですが、半日年休を使用した場合にF列の始業時間と
 H列の終業時間は実際働いた時間を記入し労働時間のAA列は所定労働時間を記入すると
 いう複雑な事もあり実際運用にまでは至りませんでした。
 しかし今後取り入れていこうと考えています。
 (4949)

    

 折り返して表示、見やすいです。有り難う御座います。

 >実際はAA101:AB155の時給者かつ日勤者のみしか数式は入っていないです。
 そうなんですか。
 時間の計算は皆さん悩まれる問題ですからね。。。

 まず確認ですが、Worksheet_Changeのコードは使っていますか?
 それとも、これも使っていないですか?

 それから「時給者かつ日勤者」ってのは 101〜155行目 と言う以外に
 何か特定出来る物が有りますか?

 前回の物もそうですが、○行目〜△行目 の様にコード内で指定した場合
 配置が変わった時に コード内の該当個所を変更して回らないといけなく成ります。
 変更漏れが有ると、間違った結果に成ったりします。
 なので、出来れば シートの状態から特定出来る様にしておいた方が良いと思います。
 例えば、A列に「時給日勤」と書いてあったらAA,AB列に自動計算をする と言うルールにするとか。。。
 この様にしておけば、配置が変わってもコードを変更する必要が無くなります。

 (HANA)

 >まず確認ですが、Worksheet_Changeのコードは使っていますか?
 >それとも、これも使っていないですか?
 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 は使用してます。
 上記マクロをWorkbookへ移動したので。。。

 日々勤務表のB11列から下へ正社員、契約社員A 契約社員B パートA・・・はsheet2から関数で
 しております。
 契約社員B以降はすべて時給者の日勤になります。
 しかしそのB列を今のところ何かに使用してるってわけではないです。
 (4949)


 >日々勤務表のB11列から下へ正社員、契約社員A 契約社員B パートA・・・はsheet2から関数で
 >しております。
 各行に文字列が入力されてる って事ですかね。。。?

 >上記マクロをWorkbookへ移動したので。。。
 そのコードは見せてもらえますか?

 >契約社員B以降はすべて時給者の日勤になります。
 B列の値を確認して、「正社員」「契約社員A」以外だったら
 AA,AB列を計算すれば良いのですね?

 次に計算のタイミングですが、
 F,H,AY列のデータが変わった時ですね?
  AY列のデータって変わることが有るのかな??

 変化が有ったセルのB列の値が「正社員」,「契約社員A」,(空白)以外で
  列が F,H,K,M,N,O,AY列のどれかで
            ~~~~~~~この4列はコードがF,H列の値を書き替えるので
   F,H列がどちらにも入力が有るとき・・・・・・・・・・・・・・計算
   F,H列のどちらか(或いは両方)空白のとき・・・・・・・・・・データ削除

 ってコードに成れば良いですか?

 MIN(7.75,((H101-F101)*24)-IF(H101>0.5,AY101,0)) の式は
 Application.Min(7.75, ((Cells(r.Row, "H").Value - Cells(r.Row, "F").Value) * 24) _
     - IIf(Cells(r.Row, "H").Value > 0.5, Cells(r.Row, "AY").Value, 0))
 になります。

 MIN関数はVBAでも使えるので「Application.」を付けてそのまま使用。
 セル番地は Cells(r.Row, 列) に置き換え。
 IF関数は VBA の方の似た関数 IIf関数 を使って居ます。

 Changeイベントのコードが
 If Intersect(Target, Columns("K:O")) Is Nothing Then Exit Sub
 に成っていた場合、F,H,AY列の変化では Exit Sub してしまうので
    Intersect(Target, Range("F:O,AY:AY"))
 の様にしてみて下さい。

 (HANA)

 >各行に文字列が入力されてる って事ですかね。。。?
 そういうことになります。

 >上記マクロをWorkbookへ移動したので。。。
 >そのコードは見せてもらえますか?
 下記なります。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name Like "*日" Then
    If Intersect(Target, Columns("K:O")) Is Nothing Then Exit Sub
 End If

 Dim r As Range
    For Each r In Target
        If r.Column = 11 Then ' K列なら
            Select Case r.Value
                Case "○"
                   Cells(r.Row, "F").Value = "8:30:00"
                   Cells(r.Row, "H").Value = "17:15:00"
                   Cells(r.Row, "AY").Value = "1.00"
                Case "●"
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "17:15:00"
                    Cells(r.Row, "AY").Value = "1.00"
                Case "◆"
                    Cells(r.Row, "F").Value = "9:00:00"
                    Cells(r.Row, "H").Value = "15:30:00"
                    Cells(r.Row, "AY").Value = "1.00"
            End Select
        End If

        If r.Column = 13 Then ' M列なら
           Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "17:00:00"
                    Cells(r.Row, "H").Value = "1:45:00"
                    Cells(r.Row, "AY").Value = "1.00"
            End Select
        End If

        If r.Column = 14 Then ' N列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "19:00:00"
                    Cells(r.Row, "H").Value = "3:45:00"
                    Cells(r.Row, "AY").Value = "1.00"
            End Select
        End If

        If r.Column = 15 Then ' O列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "1:00:00"
                    Cells(r.Row, "H").Value = "9:00:00"
                    Cells(r.Row, "AY").Value = "0.75"

            End Select

        End If
    Next
 Application.EnableEvents = True
 End Sub

 >B列の値を確認して、「正社員」「契約社員A」以外だったら
 >AA,AB列を計算すれば良いのですね?
 はい。

 >次に計算のタイミングですが、
 >F,H,AY列のデータが変わった時ですね?
 >AY列のデータって変わることが有るのかな??
 FH列はK:O11以降に○などを入れた場合FもHも同時入力になりますしAYはその休憩時間を
 反映させてるだけなので○の位置が変わればAYも変わります。
 しかし現在は日勤者かつ時給者のみなのでAYはすべて1.00です。

 話は戻りますが日々勤務表を入力しそのデータを個人勤務表に転記のマクロを作成して
 いただきましたがたとえば16日の勤務表を入力し個人勤務表の11をアクティブにしないと転記
 は出来ないですよね?
 別に集計のシートがあるのですがそちらはやはり日々勤務表からの集計にしたほうが
 よろしいのでしょうか?
 現在は個人勤務表からの集計にしてますのでアクティブにしてないと数字が反映しないので。。。
 よろしくお願いします。
 (4949)


 おや?
 If Sh.Name Like "*日" Then
    If Intersect(Target, Columns("K:O")) Is Nothing Then Exit Sub
 End If

 これだと、日々勤務表だった場合で、K:O列以外の変更だった場合 マクロ終了 に成ってしまいます。
 日々勤務表以外だったらとにかく、マクロは実行しなくて良いですよね?

 他のシートの変更でも使いたい事が有るかもしれませんので、ここはひとつ

 If Sh.Name Like "*日" Then
    If Not Intersect(Target, Columns("K:O")) Is Nothing Then
       〜ここに 日々勤務表だった場合で、K:O列の変更だった時に
     動かしたいマクロを書く               〜
    End If
 End If

 と言う作りにしておいた方が良いかもしれないですね。
 あと、L列は入力するが変化してもマクロは実行しない様なので
 もっときちんと指定した方が良いかもしれません。

 先程も、「Range("F:O,AY:AY")」なんて適当に書きましたが。。。

 それから、前の時も書きましたが
 Application.EnableEvents = False
 が無いみたいですが。。。?

 >>AY列のデータって変わることが有るのかな??
 ってのは、F,H列の様に後から単独で変更することが有るか無いか
 の疑問でしたが。。。数式内で使っているので
 まずは変更する可能性が有るパターンで考えておいて良いと思います。

 >別に集計のシートがあるのですがそちらはやはり日々勤務表からの集計にしたほうが
 >よろしいのでしょうか?
 どの様な集計の必要が有るかに寄ると思います。
 これもどうせマクロ化するのなら、どちらが早いかでしょうかね?
  日々勤務表から集計して結果を出すのと
  個人勤務表に個人別に集計してからその結果を集めるのと。

 一連のコードが作れたら、その件はご自身で解決できる様に成っているのではないかと思います。

 まずは新しいブックに日々勤務表のシートを一つ複製して
 そのシートモジュールで再計算するコードを作ってみられてはどうでしょう。

 (HANA)

 End IfがEnd Subの上へ移動でした。
 申し訳ありません。

 If Not Intersect(Target, Range("F:F,H:H,K:K,M:O,R:R,AY:AY")) Is Nothing Then

     Application.EnableEvents = False

 この式で起動はしてるみたいですが大丈夫ですか?

 質問ばかりで申し訳ないのですが、
 AD列に深夜時間を転記する箇所を追加したのですが
 O列(3直)の場合深夜時間が部署によって違うので、
 O列のみに”○”を入力するとAD列に3.25と表示されO列とR列に○が入力されると
 4.00と入力されるとしたいのです。
 下記のマクロだと○を入力するタイミング(順番)が遅い方がAD列に認識されるので
 条件を入れないといけないというのは分かるのですが。。。

  If r.Column = 15 Then  ' O列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "1:00:00"
                    Cells(r.Row, "H").Value = "9:00:00"
                    Cells(r.Row, "AD").Value = "3.25"
                    Cells(r.Row, "AY").Value = "0.75"

            End Select

        End If

        If r.Column = 18 Then ' R列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "1:00:00"
                    Cells(r.Row, "H").Value = "9:00:00"
                    Cells(r.Row, "AD").Value = "4.00"
                    Cells(r.Row, "AY").Value = "0.75"

            End Select

 それから、またまた質問で申し訳ないのですが、
 KやM:Oに○を入力し○を削除した場合F列、H列も削除を追加したいのですが上記の中に
 追加できますか?
 質問ばかりで申し訳ありません。
 よろしくお願いします。

 >まずは新しいブックに日々勤務表のシートを一つ複製して
 >そのシートモジュールで再計算するコードを作ってみられてはどうでしょう。
 この件は自力で頑張ってみます。

 (4949)

 >If Not Intersect(Target, Range("F:F,H:H,K:K,M:O,R:R,AY:AY")) Is Nothing Then
 大丈夫と思います。

 >O列のみに”○”を入力するとAD列に3.25と表示されO列とR列に○が入力されると
 >4.00と入力されるとしたいのです。
 O列とR列の変化で、AD列に値を設定するときに
 相手列のデータ状態を確認する様にしてはどうでしょう?

 O列に○が入力されていたら
     If Cells(r.Row, "R").Value = "○" Then   '相手の列のデータを確認
         Cells(r.Row, "AD").Value = "4.00"
     Else
         Cells(r.Row, "AD").Value = "3.25"
     End If

 >KやM:Oに○を入力し○を削除した場合F列、H列も削除を追加したいのですが
 ちょっととりとめの無いコードに成ってしまいますが
 For Each r In Target の後で

 If r.Column が 11,13,14,15 のいずれか? Then
     If r.Value が 入力が無いか? Then
         セルを.ClearContents
     Else
         今のコード
     End If
 End If

 の様にしてみるとどうでしょう?

 或いは、Case Else を追加すると それまでの Caseに当てはまらなかった時
 その部分が実行されます。

 R列の扱いがよく分からないですが。

 変更してみて、ごちゃごちゃする様なら もう少し考えた方が良いかもしれません。

 現在使って居られるコードを見てみると、M列以降は○かどうかの判定しかしてないので
 (好みの問題とは思いますが)Ifで判定。K列は ElseIf で判定しても良さそうに思います。

 それから、今の状態だと 始業時間や終業時間を入れる列が変わったらコード内の"F"や"H"を
 書き替えていかないといけないですね。

 なので、それぞれは一旦変数で受けておいて 最後に該当のセルに入れる様にすると
 良いかもしれません。

 Dim StaTime As String, CloTime As String, BreTime As String
 なんてのを追加して

 If r.Value = "○" Then
     StaTime = "8:30:00"
     CloTime = "17:15:00"
     BreTime = "1.00"
 ElseIf r.Value = "●" Then
     StaTime = "9:00:00"
     CloTime = "17:15:00"
     BreTime = "1.00"
 ElseIf r.Value = "◆" Then
     StaTime = "9:00:00"
     CloTime = "15:30:00"
     BreTime = "1.00"
 Else '↓確認しながら消すならこんな感じで。
     StaTime = ""
     CloTime = ""
     BreTime = ""
 End If

 の様にしておいて、最後に
     Cells(r.Row, "F").Value = StaTime
     Cells(r.Row, "H").Value = CloTime
     Cells(r.Row, "AY").Value = BreTime

 (HANA)

 >O列に○が入力されていたら
     >If Cells(r.Row, "R").Value = "○" Then   '相手の列のデータを確認
         >Cells(r.Row, "AD").Value = "4.00"
     >Else
         >Cells(r.Row, "AD").Value = "3.25"
     >End If
 を入れると、かなり遅くなるのですが入れる場所が悪いのでしょうか?

 Nextの上に入れたのですが。。。
 (4949)


 O列に○が入力されていたら
  If r.Column = 15 Then  ' O列なら
            Select Case r.Value
                Case "○"
 の判定が通った後に
                    Cells(r.Row, "AD").Value = "3.25"
 で無条件で「3.25」の時間を設定する前に、
 Cells(r.Row, "R").Value の値はどうかな?
 の確認が要るのですよね?

  If r.Column = 15 Then  ' O列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "1:00:00"
                    Cells(r.Row, "H").Value = "9:00:00"
                    Cells(r.Row, "AD").Value = "3.25"
                    Cells(r.Row, "AY").Value = "0.75"
            End Select
  End If

 の部分で

  If r.Column = 15 Then  ' O列なら
            Select Case r.Value
                Case "○"
                    Cells(r.Row, "F").Value = "1:00:00"
                    Cells(r.Row, "H").Value = "9:00:00"

                    If Cells(r.Row, "R").Value = "○" Then   '相手の列のデータを確認
                        Cells(r.Row, "AD").Value = "4.00"
                    Else
                        Cells(r.Row, "AD").Value = "3.25"
                    End If

                    Cells(r.Row, "AY").Value = "0.75"
            End Select
  End If

 要件が違うでしょうか?

 (HANA)

 すみません。ばっちりでした。
 まだまだ素人でした。。。

 >If r.Column が 11,13,14,15 のいずれか? Then
     >If r.Value が 入力が無いか? Then
         >セルを.ClearContents
     >Else
         >今のコード
     >End If
 >End If

 を入れるとnextに対するForがありませんと出ますが
 Forは追加してないのに。。。。
 (4949)


 でも何かがセットに成っていないのだと思います。

 たとえば↓のコードは
    Sub TEST()
    Dim r As Range
        For Each r In Range("A1:A10")
            If r.Value = 1 Then

            Else
        Next
    End Sub

 If 〜 End If で対なのに、If 〜 Else に成っているのが問題で
 For Each 〜 Next の方はちゃんと対に成っているのに
 「コンパイルエラー:Nextに対するForがありません」と出ます。

 何をどの様に追加したのかわからないですが、まずは インデントを正しくつけて
 きちんと対に成っているか確認してみてください。

 いきなり追加するのではなく、一旦
            Set r = ActiveCell  '←で実際のコードに近づけておく
            If r.Value = 1 Then
                MsgBox "値:1"
            End If
 標準モジュールにこんな感じでコードを書いて確認してから
 実際のコードに追加してみるのが良いかもしれません。

 (HANA)

 If r.Column = が 11,13,14,15 のいずれか? Then ←いずれかをどのように定義すればよいものか
                           わかりません。
 >If r.Value = <>”” Then  ←この部分が私にマクロの知識がないので。。。 
 Selection.ClearContents       ←これで良いかは分かりませんけど。。。
 Else

 申し訳ないですけどお願いします。
(4949)


 >いずれかをどのように定義すればよいものかわかりません。

 対面していたら、雰囲気やスピード等から色々つかめると思うのですが
 Webだとなかなかそうも行かなくて。。。
 考えてみて分からない所は、気にせず「分からない」と書いて下さいね。
 自分が分からない所がどこか分かる ってのは、大切な事だと思っています。

 さて、前スレですが
 >>If 11 <= ActiveSheet.Name And ActiveSheet.Name <= 605 Then
 これで、アクティブシートの名前が 11以上 且つ 605以下(11〜605の間)かどうか
 を確認しました。                         ~~~~

 「いずれか」は Or で確認して下さい。

 If r.Column = 11 or r.Column =13 or r.Column = 14 ・・・・

 ただ、13〜15は連続しているので、ここは And で確認しても良いかもしれませんが。

 >If r.Value = <>”” Then  ←この部分が私にマクロの知識がないので。。。 
 これで良いと思います。
 【マクロ!!】なんて身構えずに、挑んでみてもらえれば良いと思います。

 >Selection.ClearContents       ←これで良いかは分かりませんけど。。。
 これは。。。事前に Select するつもりならこれでも良いかもしれませんが
 そう言うわけでは無いので問題有り です。

 何をしたいかと言うと「○を削除した場合F列、H列も削除」ですよね?
 なので rのセルに入力が無かった場合、F列のセルとH列のセルの内容を削除なので。

     Cells(r.Row, "F").ClearContents
     Cells(r.Row, "H").ClearContents

 ↑で少し書きましたが、一旦変数で受けるなら
     StaTime = ""
     CloTime = ""
 としても良いかもしれません。

 (HANA)


 For Each r In Target

    If r.Column = 11 Or r.Column = 13 <= r.Column And r.Column <= 15 Then
    If r.Value <> "" Then
    Cells(r.Row, "F").ClearContents
    Cells(r.Row, "H").ClearContents
    Else

 If r.Column = 11 Then ' K列なら
    ・
   ・今までのコード
    ・ 
  Next
 End If
     Application.EnableEvents = True
 End If
 End Sub

  このコードでまたコンパイルエラー:Nextに対するForがありません。。。
 と出ました。
 今までのコードのところは起動してるので追加したコードのところだと
 思いますが。。。

 >Set r = ActiveCell  '←で実際のコードに近づけておく
            >If r.Value = 1 Then
                >MsgBox "値:1"
            >End If
 このコードは選択したセルに1が入力されてたらメッセージボックスに1と表示されるですよね。

 正直前回アドバイスいただきましたが分かりません。
 よろしくお願いします。
 (4949)


 ご提示の部分が正確に抜き出せているのなら。。。
 こんな感じで、対に成るようにインデントを付けます。

    For Each r In Target '−−−−−−−rのループ開始
        If r.Column = 11 Or r.Column = 13 <= r.Column And r.Column <= 15 Then   '列の確認 If Then
            If r.Value <> "" Then                   '値無しの確認 If Then
                Cells(r.Row, "F").ClearContents
                Cells(r.Row, "H").ClearContents
            Else                                    '値無しの確認 Else
                '今までのコード
                'If r.Column = 11 Then ' K列なら
                '
                '
                '
                'End If
    Next                '−−−−−−−rのループのNext
            End If                                  '値無しの確認 End If
        Application.EnableEvents = True
        End If                                                                  '列の確認 End If

 すると、rのループのNextの位置がおかしい様に感じます。

 rに一つ値が入ったら(For Each r In Target)
  列の確認 Then
    値の確認 Then
      セルの値の削除が必要なら削除
       Else
      セルに値を入れるなら、条件に従って入れる
       値の確認のIf 終わり
   列の確認のIf 終わり
 セルに値を入れる or セルの値を削除 が終わったら、次のr(Next)
 全部の r が終わったら Application.EnableEvents = True に戻す。

 確認してみて下さい。

 ひとまず
 >このコードは選択したセルに1が入力されてたらメッセージボックスに1と表示されるですよね。
 の方は、保留にしておきます。

 (HANA)

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)								

 If Sh.Name Like "*日" Then                              'シート名が 日を選択した場合 Then								

    Application.EnableEvents = False    '解除								

     If Not Intersect(Target, Range("K:K,M:O,R:R")) Is Nothing Then   'K,M:O,Rが選択されたら If Then								

  Dim r As Range    '変数r								

    For Each r In Target   '−−−−−−−rのループ開始								

    If r.Column = 11 Or r.Column = 13 <= r.Column And r.Column <= 15 Then  '列の確認 If Then								
    If r.Value <> "" Then                              '値無しの確認 If Then						
    Cells(r.Row, "F").ClearContents      'F列クリア						
    Cells(r.Row, "H").ClearContents      'H列クリア						

    Else          '値無しの確認 Else						・
         ・
         ・

        If r.Column = 18 Then ' R列なら								
            Select Case r.Value								
                Case "○"								
                    Cells(r.Row, "F").Value = "1:00:00"								
                    Cells(r.Row, "H").Value = "9:00:00"								
                    Cells(r.Row, "AD").Value = "4.00"								
                    Cells(r.Row, "AY").Value = "0.75"								
            End Select								
        End If								

   End If                         '値無しの確認 End If								
     End If                       '列の確認 End If								
        Next     '−−−−−−−rのループのNext								

  End If                                                          'シート名が 日を選択した場合End If								
     End If                       '  'K,M:O,Rが選択されたら End If								
 Application.EnableEvents = True  '実行								
End Sub	
 こんな感じですが
 ん。。。Nextの位置はここではないということですよね。。。。。。。
 (4949)...							


 それは、合っていると思いますが。同じメッセージが出ますか?
   「インデント」ってどこの事か分かりますか?
   先頭の余白の事ですが。。。
   ご提示のコードは、インデントがバラバラですね。
   例えば rのループ開始 から rのループのNext が一つのまとまりなので
   この2行の書き出す位置を同じにして、この間に有る部分は右側に一段下げます。

 新しいブックを用意
 Sheet1のシート名を「1日」に変更
 そのブックのThisWorkbookモジュールにご提示のコードを貼り付け
         ・
         ・
   はコメントアウトか、削除。
     If Sh.Name Like "*日" Then の上に「Stop」の一行を追加  

 「1日」のシートのどこかのセルに何か文字を入力すると
 Stop の所で止まるので、[F5]で続きを実行して下さい。

 Stop の所で止まる前に、「Nextに対するForが〜〜」と言われますか?
 新しいブック&直上に載せられたコードで、試してみて下さいね。

 (HANA)

 上記のマクロでは「Nextに対するForが〜〜」は出ないのですが、FH列に時間が表示されなく
 なりました。。。。
 Cells(r.Row, "F").ClearContents      'F列クリアが黄色になり
 r.Rowにカーソルを持っていくと r.Row=5 となってました。

 >1日」のシートのどこかのセルに何か文字を入力すると
 >Stop の所で止まるので、[F5]で続きを実行して下さい。
 F5を押したら黄色が消えるのみですが?

 >Stop の所で止まる前に、「Nextに対するForが〜〜」と言われますか?
 >新しいブック&直上に載せられたコードで、試してみて下さいね。
 「Nextに対するForが〜〜」は出ないのですが、FH列に時間が表示されなくなりました。。。。
 (4949)


 >上記のマクロでは「Nextに対するForが〜〜」は出ないのですが
 ですね。実際のコードの方ではどうですか?
 そちらもエラーに成らない事は確認出来ましたか?

 時間が入力されるべきパターンで[F8]を押して貰ったら
 > Cells(r.Row, "F").ClearContents      'F列クリアが黄色になり
 > r.Rowにカーソルを持っていくと r.Row=5 となってました。
 に成りましたか?

 スミマセン。
 >>If r.Value = <>”” Then  ←この部分が私にマクロの知識がないので。。。
 >これで良いと思います。
 >【マクロ!!】なんて身構えずに、挑んでみてもらえれば良いと思います。
 なんて書きましたが、 r.Value が「""」の時に 各セルの値をクリアするので
 If r.Value = "" Then
           ~~~~~ でしたね。
 r.Value <> "" では、rに何か入力が有った時に Then の中が実行されて仕舞います。

 その部分を変更してもう一度、動きを確認してみて下さい。
 今度はきちんと Else の方へ分岐すると思います。

 それと
 >If r.Column = 11 Or r.Column = 13 <= r.Column And r.Column <= 15 Then  
 は、K,M,N,O列の変更だった時にだけ以降のマクロが実行されます。
 この中にR列が含まれないので
 >       If r.Column = 18 Then ' R列なら
 が実行される事は確実に無いですよね?

 R列の値を削除した場合は、F,H列等の値は何もしないのですか?
 でしたら、もう少し考えないといけないですね。。。

 (HANA)

  >If r.Value = "" Then
           > ~~~~~ でしたね。
 この部分を変更し実行できました。
 FH列削除になりました。
 ありがとうございました。

 >>If r.Column = 11 Or r.Column = 13 <= r.Column And r.Column <= 15 Then  
 >は、K,M,N,O列の変更だった時にだけ以降のマクロが実行されます。
 >この中にR列が含まれないので
 >       If r.Column = 18 Then ' R列なら
 >が実行される事は確実に無いですよね?
 >R列の値を削除した場合は、F,H列等の値は何もしないのですか?
 >でしたら、もう少し考えないといけないですね。。。

 If r.Column = 11 Or r.Column = 18 Or r.Column = 13 <= r.Column And r.Column <= 15 Then
  らR列も実行にはなりますが
 これは例えば2直に○をいれ3直にも○を入れ2直の○を削除するとFH列が
 消えてしまいますね。。。。
  このことですか?
 (4949)


 >2直に○をいれ3直にも○を入れ2直の○を削除する
 あ、そう言う事をしますか?
 でしたら、消えてしまいますね。。。

 R列の云々を書いたのは、
 r.Column = 18 が無ければ Else の方にも分岐せずにマクロが終わって仕舞う。
 って事だったのですが。

 (HANA)

 >あ、そう言う事をしますか?
 >でしたら、消えてしまいますね。。。

 私がするのではなく完成した後、別の入力者がそのようにする可能性があるかも?
 という、事でした。
 前もって言っておけばそのところは回避できそうです。

 >r.Column = 18 が無ければ Else の方にも分岐せずにマクロが終わって仕舞う。
 >って事だったのですが。

 If r.Column = 11 Or r.Column = 18 Or r.Column = 13 <= r.Column And r.Column <= 15 Then

 これで回避できそうですが。。。
 少し概念が外れてますか?
 (4949)

 >私がするのではなく完成した後、別の入力者がそのようにする可能性があるかも?
 そうですね。

 これは、入力が有ったら セルに時間を入れますよね?
 その時に、それ以外のセルの記号を消す事にするのはどうでしょう。

 2直に○をいれ3直にも○を入れた場合
 マクロが3直の時間をセルに入力する時に、同時に3直以外のセルの○(等)を削除する。

 >If r.Column = 11 Or r.Column = 18 Or r.Column = 13 <= r.Column And r.Column <= 15 Then
 R列の値が削除された時も F,Hの時間が削除されて良いなら それで良いと思いますが。。。
 どうなんでしょう?
 最初の時に、R列に関して書いてなかったので
 >>R列の扱いがよく分からないですが。
 と書くだけで、私はスルーしてたのですが。

 もしかしたら、O列とR列は別処理にしないといけないのでは?
 或いは消す時は無条件で関連の所をすべて消すとか。。。
   既にそのおつもりなのかもしれませんが。

 (HANA)


 >これは、入力が有ったら セルに時間を入れますよね?
 >その時に、それ以外のセルの記号を消す事にするのはどうでしょう。
 >2直に○をいれ3直にも○を入れた場合
 >マクロが3直の時間をセルに入力する時に、同時に3直以外のセルの○(等)を削除する。

 そのほうが私としては理想です。 
 RとO列は対に考えないといけないですし
 Kを入力したらM,N,O,Rは削除
 Nを入力したらK,M,O,R,ADを削除かつNの深夜を表示
 Mを入力したらK,N,O,R,ADを削除かつMの深夜を表示
 Oを入力したらK,M,N,R,ADを削除かつOの深夜を表示かつRに○があればRの深夜の時間を表示
 というのが全くの理想になります。

 複雑ですがよろしくお願いします。
 (4949)


 >そのほうが私としては理想です。
 でしたら 
 >>Else '↓確認しながら消すならこんな感じで。
 >>    StaTime = ""
 >>    CloTime = ""
 >>    BreTime = ""
 >>End If
 じゃないでしょうか?

 もしかしたら
     ElseIf r.Value = "" Then
 の方が良いかもしれませんが。

 (HANA)


 うーーーーーーまた苦戦。
 >Dim StaTime As String, CloTime As String, BreTime As String
 >なんてのを追加して

 >If r.Value = "○" Then
     >StaTime = "8:30:00"
     >CloTime = "17:15:00"
     >BreTime = "1.00"
 >ElseIf r.Value = "●" Then
     >StaTime = "9:00:00"
     >CloTime = "17:15:00"
     >BreTime = "1.00"
 >ElseIf r.Value = "◆" Then
     >StaTime = "9:00:00"
     >CloTime = "15:30:00"
     >BreTime = "1.00"
 >Else '↓確認しながら消すならこんな感じで。
     >StaTime = ""
     >CloTime = ""
     >BreTime = ""
 >End If

 >の様にしておいて、最後に
     >Cells(r.Row, "F").Value = StaTime
     >Cells(r.Row, "H").Value = CloTime
     >Cells(r.Row, "AY").Value = BreTime

 を私なりに作成
 Dim StaTime As String, CloTime As String, BreTime As String, ShiTime As String

 If r.Column = 11 Then ' K列なら
 If r.Value = "○" Then
               StaTime = "8:30:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "●" Then
               StaTime = "9:00:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "◆" Then
               StaTime = "9:00:00"
               CloTime = "15:30:00"
               BreTime = "1.00"
           Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
           End If

        If r.Column = 13 Then ' M列なら
        If r.Value = "○" Then
               StaTime = "17:00:00"
               CloTime = "1:45:00"
               BreTime = "1.00"
               ShiTime = "3.75"
        Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""
               .
               .

        End If
    End If

     Cells(r.Row, "F").Value = StaTime
     Cells(r.Row, "H").Value = CloTime
     Cells(r.Row, "AY").Value = BreTime
     Cells(r.Row, "AD").Value = ShiTime

  End If
 Next

 がしかし。。。
 11の列は認識するのに13列は○転記は出来ますがFH列が表示されません。
 11列は深夜時間がないので13列に追加してみましたが甘かったようです。
 理解してなくて作成してるので、ところがイマイチ分かってないようです。

 (4949)


 >11の列は認識するのに
 「認識する」と言うのは、どういった状態の事ですか?

 >13列は○転記は出来ますがFH列が表示されません。
 「○転記は出来ます」ってのは、どうなるという事ですか?

 >11列は深夜時間がないので13列に追加してみましたが
 ってのの意味が良く分からないです。
 ↑にご提示のコードは、その 追加してみたコードでしょうか?

 For Each r In Target が無いのに、Next が有るとか
 正確に抜き出しているなら、End If の位置がおかしい様な。。。?
  でも、For Each 〜 も無い様なので
  全体を見たらそれで合っていて、別の所に問題があるのかも?

 あ、End Ifの位置がやっぱりおかしくて
        If r.Column = 13 Then ' M列なら
 の上に、一つ要るのでは?
 でないと、11列だった時にだけ実行されているのに
 13列目か確認しても、絶対13列目じゃないですよね。

 でも「○転記は出来ます」がよく分からないなぁ。
 やっぱり、End If は記載漏れかな?

 (HANA)

 Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)

 If sh.Name Like "*日" Then                              'シート名が 日を選択した場合 Then     

  Dim r As Range    '変数r

  For Each r In Target   '−−−−−−−rのループ開始

  Dim StaTime As String, CloTime As String, BreTime As String , ShiTime As String
                                ^^^^^^^^^^
                                 ここを追加しました。

          If r.Column = 11 Then ' K列なら
          If r.Value = "○" Then
               StaTime = "8:30:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "●" Then
               StaTime = "9:00:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "◆" Then
               StaTime = "9:00:00"
               CloTime = "15:30:00"
               BreTime = "1.00"
           Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
           End If

         End If

        If r.Column = 13 Then ' M列なら
        If r.Value = "○" Then
               StaTime = "17:00:00"
               CloTime = "1:45:00"
               BreTime = "1.00"
               ShiTime = "3.75"  ←ここを追加しましたが。
         Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""    ←ここを追加しました。

          End If
     End If

        ・
    ・
    ・

     Cells(r.Row, "F").Value = StaTime
     Cells(r.Row, "H").Value = CloTime
     Cells(r.Row, "AY").Value = BreTime
     Cells(r.Row, "AD").Value = ShiTime  ←ここを追加しました。

  Next     '−−−−−−−rのループのNext

     End If                       'シート名が 日を選択した場合End If

    Application.EnableEvents = True  '実行

 End Sub

 >「認識する」と言うのは、どういった状態の事ですか?
 認識するではなくきちんと表示される。
 11列に○を入れるとFH列に時間が表示されるということです。
 マクロが正常に動く?です。

 >13列は○転記は出来ますがFH列が表示されません。
 >「○転記は出来ます」ってのは、どうなるという事ですか?
 ○は表示されるけれどもFH列の時間が入らないということです。
 言葉の使い方が変でした。すみません。

 >11列は深夜時間がないので13列に追加してみましたが
 ShiTimeを追加したということです。
 13から15と18列は○が入ると深夜時間のAD列に数字が入るから必要かな
 と思ったのですが、必要なかったですか?

 作成したコードを上記に書いてますので見ていただいてよろしいでしょうか?
 よろしくお願いします。
 (4949)

 >>「認識する」と言うのは、どういった状態の事ですか?
 >マクロが正常に動く?です。
 >>「○転記は出来ます」ってのは、どうなるという事ですか?
 >○は表示されるけれどもFH列の時間が入らないということです。
 >>11列は深夜時間がないので13列に追加してみましたが
 >ShiTimeを追加したということです。

 よくわかりました。
   詳しくお伺いしてみると、最初の時にその様な表現に成っていた事に納得です。
 End If の場所もおかしくない様です。

 コードの先頭の方に Stop を入れて [F8]で一行ずつ実行しながら
 動きや変数の内容を確認して下さい。

 13列に「○」を入れた時、各変数に時間を入れる部分は実行されていますか?
 また、その時 各変数に、希望した値が入りますか?
 その後、書き出す所
     Cells(r.Row, "F").Value = StaTime
     Cells(r.Row, "H").Value = CloTime
     Cells(r.Row, "AY").Value = BreTime
     Cells(r.Row, "AD").Value = ShiTime
 まで行ったとき、各変数には希望した値が入っていますか?
 r.Row は、想定している行と同じ行に成っていますか?

 現在、複数セルに同時入力を想定して
   For Each r In Target
 で処理をしています。

 すると、ShiTimeに"3.75"が入ったら、その後11列の処理をした時も
 ShiTimeに"3.75"が入ったままに成ってしまいます。

 11列に○を入れた時、ShiTimeに何も入れなくても良くても
 ShiTimeを空にする目的で ="" を書いておくのが良いのではないかと思います。

 (HANA)


 >13列に「○」を入れた時、各変数に時間を入れる部分は実行されていますか?
 F8で確認しましたが実行されません。

 If r.Column = 11 Then ' K列なら
 から
 End Ifに飛び
 If r.Column = 13 Then ' M列なら
 から
 End Ifに飛び
 Cells(r.Row, "F").Value = StaTime
 に飛び永遠にNextしてます。

 >r.Row は、想定している行と同じ行に成っていますか?
 ここの意味がわかりません。
 (4949)


 >F8で確認しましたが実行されません。
 おかしいですね。

 13列に「○」をいれたら
 >If r.Column = 13 Then ' M列なら
 >から
 >End Ifに飛び
 飛んじゃだめですよね。

 もしかして、
  Application.EnableEvents = False
 が入っていないのでは?

 この場合、Cells(r.Row, "F").Value = StaTime でセルに値を入れた時に
 エクセル君が「セルの値がかわった!!マクロ実行しないと!!」と思い
 Selection_Changeイベントを発動させてしまいます。

 ・・・ただ、これだと最初の実行で13で分岐するし、F列には値が入ると思いますが。。。

 それから、 r.Column の近くにカーソルを持っていって
 チップインテキストに何と表示されるか確認してみて下さい。

 13の列を変更したのに 13以外の番号が表示される様なら
 どこかで想定違いが有ると思います。

 ちなみに、
  Application.EnableEvents = False
 のままマクロが終了すると、次にセルの値に変化が有った時に
 自動実行されなくなりますので、途中でやめた後は忘れず
  Application.EnableEvents = True
 を実行して下さい。

 >>r.Row は、想定している行と同じ行に成っていますか?
 >ここの意味がわかりません。
 エクセル君との思い違いで、4949さんが思っているセルとは違うセルに書き出されていて
 4949さんが「書き出されてない」と思って居られる可能性を考えました。

 r.Row にカーソルを当てて エクセル君がどのセルに書き出そうとしているのか確認してみて下さい。
 少なくともそのセルに、StaTimeの内容は書き出されていると思います。
  StaTimeの内容が何に成っているか(初期値のままだと、何も入っていない)分かりませんが。

 (HANA)

 >もしかして、
  >Application.EnableEvents = False
 >が入っていないのでは?

 まさにその通りでした。
 すみません。
 実行されました。
 (4949)


 結果が得られましたか。良かったです。

 先ほど保留にしていた件ですが、意図としては
  「まずは関係有る所だけでコードを作りましょう」
 でした。

 既に有るコードに、直接新しいコードを追加して上手く行かなかった時
 新しく追加したコード自体のどこかが悪かったのか
 新しく追加する場所が悪かったのか
 判断が付きにくいです。

 そこで、実際のコードに組み込む直前まで別の場所でコードを作製し、検証。
 希望通り動くコードが出来た段階で、実際のコードに追加する。
  (或いは、実際のコードの一部を 作成中のコードに追加して行き
   実際のコードにさらに近づける)
 と、間違っている箇所が分かりやすくなるのではないのかと思います。

 例えば、↓の様なコードが有ったとします。
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim r As Range
        For Each r In Target
            If r.Value = 1 Then
                MsgBox "OK"
            End If
        Next
    End Sub
 これにもう一つ、rの列が3以上(C列以降に入力された時)と言う条件を付けようとしたとき
   このコードは短いので、直接追加しても間違い無いとは思いますが。。。
 標準モジュールに
    Sub Test()
    Dim r As Range
        Set r = ActiveCell '←−−For Each r In Target の代わり
            If r.Column >= 3 Then
                MsgBox "If r.Value = 1 Then" & vbLf & _
                       "     MsgBox OK" & vbLf & _
                       "End If" & vbLf & _
                       "を実行する。"
            End If
    End Sub
 こんなコードを書いて、アクティブセルを色々動かしながら実行してみます。

 より実際のコードに近づけるには
        Set r = ActiveCell
         ↓
        For Each r In Selection
 の方が適当かもしれませんが。

 想定した環境で、メッセージボックスが表示される様になったら
 メッセージボックスの場所に、実際のコードを貼り付けて
 さらに希望通りの動きをするか確認。
 その後Private Sub Workbook_SheetChangeのコードの該当の個所に貼り付けます。

 その時に「Nextに対するForが〜〜」のメッセージが出たなら
 作ったコードではなく、埋め込んだ場所が何かおかしいと
 最初に疑ってみるべき場所が特定出来ると思います。

 (HANA)

 HANAさんすごく分かりやすいご説明ありがとうございます。
 確かに追加追加していくにつれ、ん?ん?結局どこが間違ってる?
 となっていました。

 Stop操作も勉強になりました。
 初歩からまた勉強していきます。
 (4949)


 いろいろ追加して共有にしたりしていって日々入力シートに入力済みのボタンを
 作成しました。
 その日がすべて入力し終えると”確定”
 とセルに入力し保護をかけようと思いましたがセルに何かが入力されると
 この
 Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
 が起動してしまいます。
 入力済みのボタンの時には起動しないなど可能でしょうか?

  (4949)


 Workbook_SheetChangeイベントも含め
 色々なイベントを無効にするのが

 Application.EnableEvents = False

 です。

 入力済みのボタンの時(入力済みのボタンのコード)で、セルに値を入力する前に
 Application.EnableEvents を False にして
 入力が終わったら True に戻す。

 Changeイベントの方は、セルの値を確認してから
 実行するかどうか決める様にしてみて下さい。

 ただ、「確定」を入れるセルが何処にあるのか分からないですが
 Changeイベントが実行された所で、セルの値が書き変わる感じは無いですし
 保護されていたら、セルの値を書き換える事も出来ないでしょうし・・・
 その点は、ちょっと良く分からないです。

 (HANA)

 If r.Column = 11 Then ' K列なら
          If r.Value = "○" Then
               StaTime = "8:30:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "●" Then
               StaTime = "9:00:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "◆" Then
               StaTime = "9:00:00"
               CloTime = "15:30:00"
               BreTime = "1.00"
           Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
           End If

 このマクロでF列またはH列を出社時間や退社時間を定時以外の場合変更すると
 たとえば1直に○つけて8:30 17:15とFH列に入りますが遅刻した場合9:00とF列を変更した場合
 FもH列も消えてしまいます。
 どのように変更したらよろしいでしょうか?
 お願いします。。。。。。
 (4949)


 F列を変更した場合、どの部分が実行されて
 FとHが消えるのですか?

 F列の値を書き換えた場合
 11列(K列)では無いので、ご提示の部分へは分岐しないと思います。

 F列を書き換えた後、○を消したら Else へ分岐して消えると思いますが。

 (HANA)

 K列に○を入れFH列に時間が入りそこからSTOPを起動させました。
 すると
 If r.Column = 11 Then ' K列なら   ←この部分
          If r.Value = "○" Then
               StaTime = "8:30:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "●" Then
               StaTime = "9:00:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "◆" Then
               StaTime = "9:00:00"
               CloTime = "15:30:00"
               BreTime = "1.00"
           Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
           End If          
     End If          ←この部分へ

     If r.Column = 13 Then ' M列なら ←この部分から
            ・
            ・
            ・
            ・
     End If          ←この部分へ
 18まですべてこのような感じで
   Cells(r.Row, "F").Value = StaTime
     Cells(r.Row, "H").Value = CloTime
     Cells(r.Row, "AY").Value = BreTime
     Cells(r.Row, "AD").Value = ShiTime   
  Next     '−−−−−−−rのループのNext 

 End If       'シート名が 日を選択した場合End If
  Application.EnableEvents = True  '実行
 End Sub
 でおわります。
 K列には○は入ってますがFH列は削除されてます。

 『ある位置の表示』(4949) で以前解決していただいた
 ところにも飛んで行ったりしてましてそこも影響してますか?

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

  If Sh.Name Like "*日" Then                              'シート名が 日を選択した場合 Then

  Application.EnableEvents = False                   'マクロ起動

    If Application.CutCopyMode = xlCopy Then Exit Sub

     'End If

       Cells.Interior.ColorIndex = xlNone
       Columns(Target.Column).Interior.ColorIndex = 35
       Rows(Target.Row).Interior.ColorIndex = 35
       Selection.Interior.ColorIndex = 6

    If 1 <= ActiveCell.Column & ActiveCell.Column <= 43 Then
        Range("D5").Value = Range("E" & ActiveCell.Row).Value   'D5に選択した行のE列を表示
        Range("F5").Value = Cells(8, ActiveCell.Column).Value   'F5に選択した列を表示
    End If
  Application.EnableEvents = True                      'マクロ終了

    End If
 End Sub

 (4949)


 動かして確認したいので、二つのコード(SheetSelectionChangeの方は↑で全文なら不要です)を
 載せてもらえますか?

 また K列のどのセルに「○」を入れたか教えて下さい。

 (HANA)

 >SheetSelectionChangeの方は↑で全文なら不要です)を
 >載せてもらえますか?
 上記で前文です。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

 If Sh.Name Like "*日" Then                              'シート名が 日を選択した場合 Then

     Dim r As Range    '変数r

  For Each r In Target   '−−−−−−−rのループ開始

  Dim StaTime As String, CloTime As String, BreTime As String, ShiTime As String

 Application.EnableEvents = False                   'マクロ起動

         If r.Column = 11 Then ' K列なら
          If r.Value = "○" Then
               StaTime = "8:30:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "●" Then
               StaTime = "9:00:00"
               CloTime = "17:15:00"
               BreTime = "1.00"
           ElseIf r.Value = "◆" Then
               StaTime = "9:00:00"
               CloTime = "15:30:00"
               BreTime = "1.00"
           Else   '↓確認しながら消す
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""
           End If

         End If

        If r.Column = 13 Then ' M列なら
         If r.Value = "○" Then
               StaTime = "17:00:00"
               CloTime = "1:45:00"
               BreTime = "1.00"
               ShiTime = "3.75"
          Else   '↓確認しながら消す
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""

          End If

        End If

        If r.Column = 14 Then ' M列なら
        If r.Value = "○" Then
               StaTime = "19:00:00"
               CloTime = "3:45:00"
               BreTime = "1.00"
               ShiTime = "4.75"
          Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""

          End If

        End If

       If r.Column = 15 Then ' M列なら
        If r.Value = "○" Then
               StaTime = "1:00:00"
               CloTime = "9:00:00"

               If Cells(r.Row, "R").Value = "○" Then   '相手の列のデータを確認
                        Cells(r.Row, "AD").Value = "4.00"
                   Else
                        Cells(r.Row, "AD").Value = "3.25"

                   End If

               BreTime = "0.75"
               ShiTime = "3.25"
          Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""

          End If

       End If

        If r.Column = 18 Then ' M列なら
        If r.Value = "○" Then
               StaTime = "1:00:00"
               CloTime = "9:00:00"
               BreTime = "0.75"
               ShiTime = "4.00"
          Else '↓確認しながら消すならこんな感じで。
               StaTime = ""
               CloTime = ""
               BreTime = ""
               ShiTime = ""

          End If

        End If
             Cells(r.Row, "F").Value = StaTime
     Cells(r.Row, "H").Value = CloTime
     Cells(r.Row, "AY").Value = BreTime
     Cells(r.Row, "AD").Value = ShiTime
  Next     '−−−−−−−rのループのNext

 End If       'シート名が 日を選択した場合End If
 Application.EnableEvents = True  '実行
 End Sub

 になります。
 KMNOR列以外に何かを入力するとFH列は削除されます。
 たとえばK列の11に○を入力し遅刻のQ列に○を入力するとFHは削除されます。
 お願いします。。。。。
 (4949)


 Q列に○を入力したら、どうなれば良かったのでしたか?

 >If Not Intersect(Target, Range("K:K,M:O,R:R")) Is Nothing Then
 ってのがどこかに有ったと思いますが。。。。
 ただ、入れる場所は

 >For Each r In Target   '−−−−−−−rのループ開始
 の後で、rのセルを確認した方が良かったのかもしれないです。
  If Not Intersect(r, Range("K:K,M:O,R:R")) Is Nothing Then

 KMNOR列のセルに変更が有った時だけ、 If r.Column = 11 Then 〜
 の処理をすれば良い様な気がしますが。。。違いましたか?

 ちなみに、K列の場合 記号が入力されていた時の
 ShiTime = "" の記述が無い様です。

 また、M列でADセルに直接値を書き込んでいますが
 その後、無条件で ShiTime = "3.25" を書き込み
 最後に Cells(r.Row, "AD").Value = ShiTime って事に成っていませんか?

 どちらも現在の問題とは関係無さそうなので「古いコードだった」ってだけなら良いですが。

 (HANA)


 >If Not Intersect(r, Range("K:K,M:O,R:R")) Is Nothing Then
 を
 >For Each r In Target   '−−−−−−−rのループ開始
 の後に入力し
 End Ifを
 Next     '−−−−−−−rのループのNextの前に入力すると削除されずに出来ました。
 End Ifの位置はここで大丈夫ですか?

 追加追加で私なりにしてたので、肝心な
 >If Not Intersect(r, Range("K:K,M:O,R:R")) Is Nothing Then
 が抜けてました。
 ありがとうございました。
 (4949)


 End Ifの位置、そこで大丈夫です。

 当初の様に
 >If Not Intersect(Target, Range("K:K,M:O,R:R")) Is Nothing Then
 としていた場合、K,M;O,R 以外の列のセルと同時に値を変更した場合
 それらの全てのセルに関して、If r.Column = 11 Then 〜 以降が実行されます。

 現在の様に
 >If Not Intersect(r, Range("K:K,M:O,R:R")) Is Nothing Then
 としていた場合、K,M:O,R 以外の列のセルだけを変更していた場合でも
 全てのセルに関して、これらの判定が行われます。
   判定だけで、If r.Column = 11 Then 〜 以降は実行されませんが。

 他にもセルがたくさんありそうなので、決められたセルと重複するセルだけをピックアップしておいてから
 判定の後、順次処理 をする様にした方が良いかもしれません。

 '======
Private Sub Worksheet_Change(ByVal Target As Range) '当初の方法
Dim r As Range
If Not Intersect(Target, Range("K:K,M:O,R:R")) Is Nothing Then
    For Each r In Target
        MsgBox r.Address(0, 0) & " に関して、コード実行"
    Next
End If
End Sub
 '======
Private Sub Worksheet_Change(ByVal Target As Range) '現在の方法
Dim r As Range
For Each r In Target
    MsgBox r.Address(0, 0) & " の判定"
    If Not Intersect(r, Range("K:K,M:O,R:R")) Is Nothing Then
        MsgBox r.Address(0, 0) & " に関して、コード実行"
    End If
Next
End Sub
 '======
Private Sub Worksheet_Change(ByVal Target As Range) '新しい案
Dim r As Range, Tr As Range
Set Tr = Intersect(Target, Range("K:K,M:O,R:R"))
If Not Tr Is Nothing Then
    For Each r In Tr
        MsgBox r.Address(0, 0) & " に関して、コード実行"
    Next
End If
Set Tr = Nothing
End Sub
 '======

 ↑一つずつシートモジュールに貼り付けて、
  K1:N1 セルに同時に何か文字を書き込む
  A1:D1 セルに同時に何か文字を書き込む
 等して、表示されるメッセージを確認してみて下さい。

 (HANA)

 もう一度一から私なりに理解してないところもかなりありましたので
 解読しながら作業をしてまして返信が遅くなりました。
 再度質問部分を読み返しておりましたら

 >MIN(7.75,((H101-F101)*24)-IF(H101>0.5,AY101,0)) の式は
 >Application.Min(7.75, ((Cells(r.Row, "H").Value - Cells(r.Row, "F").Value) * 24) _
 >    - IIf(Cells(r.Row, "H").Value > 0.5, Cells(r.Row, "AY").Value, 0))
 >になります。

 >MIN関数はVBAでも使えるので「Application.」を付けてそのまま使用。
 >セル番地は Cells(r.Row, 列) に置き換え。
 >IF関数は VBA の方の似た関数 IIf関数 を使って居ます。

 上記の部分を実行しておりませんでした。

 Application.Min・・・・部分は日々勤務表のB列で認識をし
 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 の中に追加なのでしょうか?
 (4949)


 入力(&それに伴い変更)されたセルが、今回の計算に関わっているか?
 B列を確認して、この数式を入れるべき行か?

 の二つを確認する必要が有ると思います。

 計算式を入れておいた場合、関係するセルの値が変わったとき 自動的に再計算してくれますが
 VBAで計算して結果を埋め込んでいた場合は、関係するセルの値が変わっても自動で値は変わりませんので
 再度VBAでの計算が必要に成ります。

 >MIN(7.75,((H101-F101)*24)-IF(H101>0.5,AY101,0)) の式は
 H列とF列とAY列のセルが関連していますので、少なくとも これらのセルの値が変更になった時は
 VBAで再計算して結果を返す必要が有りますし もしもこれらのセルが、さらに他のセルの状況に依って変わるなら
 そのタイミングでもVBAで計算させる必要が有ると思います。

 現在、「○」等が入力されてVBAで変更しようと思っているセル以外のセルが
 この計算に関連している様なら、この部分は数式として残しておくのが無難かもしれません。

 (HANA)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.