過去ログ

                                Page     571
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
   通常モードに戻る  ┃  INDEX  ┃  ≪前へ  │  次へ≫   
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
 ▼シフト表で続けて6日以上の入力ダメに  hana 03/1/17(金) 8:08
   ┗Re:シフト表で続けて6日以上の入力ダメに  ポンタ 03/1/17(金) 8:45
      ┣Re:シフト表で続けて6日以上の入力ダメに  hana 03/1/17(金) 22:37
      ┗申し訳ありません・・できません。。  hana 03/1/19(日) 23:05
         ┗Re:申し訳ありません・・できません。。  ポンタ 03/1/20(月) 11:47
            ┗で、できました!でも・・  hana 03/1/20(月) 21:16
               ┗Re:で、できました!でも・・  ポンタ 03/1/20(月) 21:50
                  ┣ありがとうございます!でも・・  hana 03/1/20(月) 22:10
                  ┗しつこくてすみません  hana 03/1/20(月) 22:18
                     ┗Re:しつこくてすみません  ポンタ 03/1/20(月) 22:25
                        ┗感涙です!!  hana 03/1/20(月) 22:55
                           ┗Re:感涙です!!  ポンタ 03/1/20(月) 23:03
                              ┗Re:感涙です!!  hana 03/1/20(月) 23:16

 ───────────────────────────────────────
 ■題名 : シフト表で続けて6日以上の入力ダメに
 ■名前 : hana
 ■日付 : 03/1/17(金) 8:08
 -------------------------------------------------------------------------
   会社でシフト表を任され、希望日に店名を入力していくと6日以上連続の場合ははじかれるような仕組みにしてくれと言われました。休みの希望を先にだして出勤を割り振るのですが、その際連続出勤は最高5日と決まっているのです。反対に1日出て1日休みなどの場合もあります。列に日付・行に人名の表を作成し、それぞれが希望日に店名などを入力するようにするのですが、どのようなやり方があるのでしょうか??とにかく入力していて、列で6連続になるとエラーが出るようになればよいのですが・・・VBA初心者で検討もつきません・・。何かご提案があれば教えて下さい。宜しくお願い致します。
 ───────────────────────────────────────  ■題名 : Re:シフト表で続けて6日以上の入力ダメに  ■名前 : ポンタ  ■日付 : 03/1/17(金) 8:45  -------------------------------------------------------------------------
   サンプルコードです。

シートのレイアウトが分からないので、
全ての範囲を対象にしてあります。

シートモジュールに貼り付けて、お試しください。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LRange As Range, RRange As Range
  Dim i As Integer
  If Target.Count > 1 Then Exit Sub
  Set LRange = Target
  Do While LRange.Column > 1
    If LRange.Offset(0, -1).Value = "" Then Exit Do
    Set LRange = LRange.Offset(0, -1)
  Loop
  Set RRange = Target
  Do While RRange.Column < 256
    If RRange.Offset(0, 1).Value = "" Then Exit Do
    Set RRange = RRange.Offset(0, 1)
  Loop
  i = RRange.Column - LRange.Column + 1
  If i > 5 Then
    MsgBox (i & "日も連続で出勤しちゃダメ!!")
  End If
End Sub
 ───────────────────────────────────────  ■題名 : Re:シフト表で続けて6日以上の入力ダメに  ■名前 : hana  ■日付 : 03/1/17(金) 22:37  -------------------------------------------------------------------------
   ありがとうございます。早速試してみます!わかる方には簡単なんですね・・。
 ───────────────────────────────────────  ■題名 : 申し訳ありません・・できません。。  ■名前 : hana  ■日付 : 03/1/19(日) 23:05  -------------------------------------------------------------------------
   ポンタ様、サンプルコードまでかいて頂き本当にありがとうございます。
あとは自分で調べながらアレンジしようと苦戦しましたが、できません・・。
勉強不足でお恥ずかしい限りです。

最終的にF6〜BD38の表があり、タイトル行(F6〜BD7)に人名等が入り、
タイトル列(F6〜H38)に日付・曜日などが入り、2列ずつを入力箇所と
して左列にコードを入れると右列に店名が出るようにVLOOKUP関数が入って
いる表になりました。(例:i8にコードを入れるとj8に店名)

つまり、コード行にコードを入れ続けていて(行を下に移動)6個目になると
エラー表示が(メッセージボックス)が出ればよいのですが・・。

何から何まで頼るなと怒られそうですが、周りに詳しい人もおらず、独学
で完成させなければならない為毎日四苦八苦しております。どうかよろしく
お願い致します。
 ───────────────────────────────────────  ■題名 : Re:申し訳ありません・・できません。。  ■名前 : ポンタ  ■日付 : 03/1/20(月) 11:47  -------------------------------------------------------------------------
   スミマセン、列と行を勘違いしておりました。

まだ。機能的に十分ではありませんが、
とりあえず、お試しください。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LRange As Range, RRange As Range
  Dim i As Integer
  If Target.Count > 1 Then Exit Sub
  Set LRange = Target
  Do While LRange.Row > 6
    If LRange.Offset(-1, 0).Value = "" Then Exit Do
    Set LRange = LRange.Offset(-1, 0)
  Loop
  Set RRange = Target
  Do While RRange.Row < 38
    If RRange.Offset(1, 0).Value = "" Then Exit Do
    Set RRange = RRange.Offset(1, 0)
  Loop
  i = RRange.Row - LRange.Row + 1
  If i > 5 Then
    MsgBox (i & "日も連続で出勤しちゃダメ!!")
  End If
End Sub
 ───────────────────────────────────────  ■題名 : で、できました!でも・・  ■名前 : hana  ■日付 : 03/1/20(月) 21:16  -------------------------------------------------------------------------
   またまたご丁寧に教えていただきありがとうございました。
感動です!コードを見ているとなるほど・・って思うんです
けど自力では何もできずにはがゆいばかりです・・。

ところが、今度はコードに1もしくは0を入力した場合以外
のみをカウントする事になり、またもや躓いてしまいました・・。
その他のコードを入れた時だけ行数を数えて教えていただいた
動きをするようには何を使えばよいのでしょうか・・?本当に
恥ずかしいのですが、半日会社で悩みぬいてちっともできず
に疲労困憊してしまいました・・。

▼ポンタ さん:
>スミマセン、列と行を勘違いしておりました。
>
>まだ。機能的に十分ではありませんが、
>とりあえず、お試しください。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>  Dim LRange As Range, RRange As Range
>  Dim i As Integer
>  If Target.Count > 1 Then Exit Sub
>  Set LRange = Target
>  Do While LRange.Row > 6
>    If LRange.Offset(-1, 0).Value = "" Then Exit Do
>    Set LRange = LRange.Offset(-1, 0)
>  Loop
>  Set RRange = Target
>  Do While RRange.Row < 38
>    If RRange.Offset(1, 0).Value = "" Then Exit Do
>    Set RRange = RRange.Offset(1, 0)
>  Loop
>  i = RRange.Row - LRange.Row + 1
>  If i > 5 Then
>    MsgBox (i & "日も連続で出勤しちゃダメ!!")
>  End If
>End Sub
 ───────────────────────────────────────  ■題名 : Re:で、できました!でも・・  ■名前 : ポンタ  ■日付 : 03/1/20(月) 21:50  -------------------------------------------------------------------------
   検証不十分ですが、とりあえず、お試しください。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LRange As Range, RRange As Range
  Dim i As Integer
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "0" Or Target.Value = "1" Then Exit Sub
  Set LRange = Target
  Do While LRange.Row > 6
    If LRange.Offset(-1, 0).Value = "0" Or _
      LRange.Offset(-1, 0).Value = "1" Then Exit Do
    Set LRange = LRange.Offset(-1, 0)
  Loop
  Set RRange = Target
  Do While RRange.Row < 38
    If RRange.Offset(1, 0).Value = "0" Or _
      RRange.Offset(1, 0).Value = "1" Then Exit Do
    Set RRange = RRange.Offset(1, 0)
  Loop
  i = RRange.Row - LRange.Row + 1
  If i > 5 Then
    MsgBox (i & "日も連続で出勤しちゃダメ!!")
  End If
End Sub
 ───────────────────────────────────────  ■題名 : ありがとうございます!でも・・  ■名前 : hana  ■日付 : 03/1/20(月) 22:10  -------------------------------------------------------------------------
   素早いレスをありがとうございます!早速試してみたのですが、
0もしくは1の入力は何回続いてもカウントされなくなりましたが、
他のコード番号を入力すると、1回(行)だけでも「33日も連続で
出勤しちゃダメ!!」となります。何回(行)続けても”33”日
とカウントされるみたいなのです。せっかく作って頂いてしつこい
ようですが、どこを変えればうまく動くのかわからないのです・・。
すみませんがご指摘頂けないでしょうか?本当に何度もすみません・・。


▼ポンタ さん:
>検証不十分ですが、とりあえず、お試しください。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>  Dim LRange As Range, RRange As Range
>  Dim i As Integer
>  If Target.Count > 1 Then Exit Sub
>  If Target.Value = "0" Or Target.Value = "1" Then Exit Sub
>  Set LRange = Target
>  Do While LRange.Row > 6
>    If LRange.Offset(-1, 0).Value = "0" Or _
>      LRange.Offset(-1, 0).Value = "1" Then Exit Do
>    Set LRange = LRange.Offset(-1, 0)
>  Loop
>  Set RRange = Target
>  Do While RRange.Row < 38
>    If RRange.Offset(1, 0).Value = "0" Or _
>      RRange.Offset(1, 0).Value = "1" Then Exit Do
>    Set RRange = RRange.Offset(1, 0)
>  Loop
>  i = RRange.Row - LRange.Row + 1
>  If i > 5 Then
>    MsgBox (i & "日も連続で出勤しちゃダメ!!")
>  End If
>End Sub
 ───────────────────────────────────────  ■題名 : しつこくてすみません  ■名前 : hana  ■日付 : 03/1/20(月) 22:18  -------------------------------------------------------------------------
   すみません。なんどか試してみたら”33”以外の数字も
出ました。途中で0や1を入力すると次にコード番号を
入れたときにその数字が変わるみたいです・・。
 ───────────────────────────────────────  ■題名 : Re:しつこくてすみません  ■名前 : ポンタ  ■日付 : 03/1/20(月) 22:25  -------------------------------------------------------------------------
   0または1または空白だったらカウントしない、
というように書き直しました。

お試しください。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LRange As Range, RRange As Range
  Dim i As Integer
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "0" Or Target.Value = "1" Then Exit Sub
  Set LRange = Target
  Do While LRange.Row > 6
    If LRange.Offset(-1, 0).Value = "0" Or _
      LRange.Offset(-1, 0).Value = "1" Or _
      LRange.Offset(-1, 0).Value = "" Then Exit Do
    Set LRange = LRange.Offset(-1, 0)
  Loop
  Set RRange = Target
  Do While RRange.Row < 38
    If RRange.Offset(1, 0).Value = "0" Or _
      RRange.Offset(1, 0).Value = "1" Or _
      RRange.Offset(1, 0).Value = "" Then Exit Do
    Set RRange = RRange.Offset(1, 0)
  Loop
  i = RRange.Row - LRange.Row + 1
  If i > 5 Then
    MsgBox (i & "日も連続で出勤しちゃダメ!!")
  End If
End Sub
 ───────────────────────────────────────  ■題名 : 感涙です!!  ■名前 : hana  ■日付 : 03/1/20(月) 22:55  -------------------------------------------------------------------------
   またもやすぐのお返事ありがとうございます!
出来ました!色々試してみましたが動きます!!

質問と言うより丸投げ状態になってしまい、貴重な
お時間を割いていただきありがとうございました。
何日も悩んでいたのでとても嬉しいです。(ちっとも
自分で出来てませんが・・・)本当に本当にありがとう
ございました!!!
 ───────────────────────────────────────  ■題名 : Re:感涙です!!  ■名前 : ポンタ  ■日付 : 03/1/20(月) 23:03  -------------------------------------------------------------------------
   お喜びのところ申し訳ありませんが、
↑のほうで書いた通り、機能的には不十分です。

1.範囲外のセルが変更された場合も動いてしまう。
2.Ctrl+Enterやコピー&ペーストされた場合に未対応

などの問題を含んでいます。

あくまでも、骨格部分のテストに成功しただけと
お考えになったほうが良いと思います。
 ───────────────────────────────────────  ■題名 : Re:感涙です!!  ■名前 : hana  ■日付 : 03/1/20(月) 23:16  -------------------------------------------------------------------------
   確かにそうですね・・。でも感謝の気持ちには変わりありません。
この先はひとまず自分で頑張ってみます・・。度々のご親切あり
がとうございました。
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━    通常モードに戻る  ┃  INDEX  ┃  ≪前へ  │  次へ≫    ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━                                 Page 571