[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CALLでプログラムを呼ぶと上手く処理されない』（なのれい）
いつもお世話になっております。
細かいコードをたくさん作り、それをCALLで繋げて１つのプログラムとして使っております。
7個ほどあるんですが、どれか1個がうまく処理されません。
順番は不問ですので、CALLの順番を変えてみたところ今度は違うプログラムの一部がうまく処理されません。
単体で実行すれば問題ないのに、CALLで何個も呼び出すと上手くいかないっていうことはあるのでしょうか？
＜ 使用 Excel：Excel2010、使用 OS：unknown ＞
＞単体で実行すれば問題ないのに、CALLで何個も呼び出すと上手くいかないっていうこと
＞はあるのでしょうか？
当然あるでしょう。
刻々と状況がかわれば、
各プロシージャが前提としている条件が変わる可能性があります。
例えば、
最終的に欲しい結果と、
その過程の一つ一つのプロシージャには、
それぞれどのような機能とを説明してみてはいかがでしょうか？
（まっつわん） 2019/09/14(土) 11:17
改善策というよりは、単体なら上手くいくのに繋げると上手くいかなくなる事があり得るのかについて回答頂きたかったんです！
コードを再確認して、それでもわからなかったら再度詳細を書いて質問したいと思います！
ありがとうございます。
（なのれい） 2019/09/14(土) 11:51
＞単体なら上手くいくのに繋げると上手くいかなくなる事があり得るのかについて
私は、普通は無いと思うんですがねぇ。。
多分「単体なら上手くいく」と言う認識が間違いではないかと推測します。
（半平太） 2019/09/14(土) 11:56
まず再確認して、どうしてもわからなければ詳細書きます！！！
（なのれい） 2019/09/14(土) 13:12
■２
＞7個ほどあるんですが、どれか1個がうまく処理されません。
実行してみたらエラーになった（想定外の結果になった）ので処理されてない。っていう発想のような気がしますが、そもそもステップ実行してテストしているのでしょうか？
ステップ実行して、1つずつ動きを追ってみれば、どこが想定外になっているかは容易に特定できそうな気がします。
（逆にいうと、回答者の手元にはデータがありませんし、質問者さんの画面を見ることができませんから検証（デバッグ）作業はご自身ですべきだと思います。）
■３
＞単体で実行すれば問題ないのに、CALLで何個も呼び出すと上手くいかないっていうことはあるのでしょうか？
既に同種の回答がありますが、例えば変数が初期値の時に処理するするようなコードが組んであって、まとめて実行するときは変数が初期化されないまま使っていてエラーになるとか考えられなくもない・・・かも
めんどくさいのかもしれませんが、個人情報に関わる部分などは秘匿するとして、現状のコードを提示したほうが、回答者側で問題点を把握しやすくなるとおもいますから、コードの提示を考えてみてはどうでしょうか？
（もこな２） 2019/09/14(土) 19:09
結局直せなくて、違うカタチでコードを書いて解決しました！
皆さんありがとうございます！
前回のコードとは関係ございません！
CALL 月曜日
CALL 火曜日
・
・
・
CALL 日曜日
までの7つをまとめてやると、どれか１つのプログラムの一部が処理されないです！
順番不問ですので、変えるとまたどれか１つのプログラムの一部が処理されない。
しかし、手動で月曜日F5 火曜日F5・・・で実行していくと上手くいくんですよねー
全然理解出来なかったです泣
もう解決しましたので、大丈夫なんですが、、、
皆さんありがとうございます！
（なのれい） 2019/09/15(日) 08:28
＞手動で月曜日F5 火曜日F5・・
この時、関連シートを手でアクティブにしてから実行してないですか？
もしその前提ならプログラムとしては「旨く行く」部類に入らないです。
回答者は千里眼じゃないですから、肝心のコードを見ないで原因を指摘するのは至難です。
（半平太） 2019/09/15(日) 09:18
コードを載せなかった事、反省しております。大変申し訳ございませんでした！
（なのれい） 2019/09/15(日) 09:59
一番言いたいのは■２のほうです。繰り返しになりますけど、デバッグ作業は自分でするのが基本だと思いますよ。
同種のコメントついてますが、コードも見せずに「実行したらどこかがおかしいようです。」と言われてもエスパーじゃありませんから回答できません。■3のほうは、ついでとして、どんなケースだったら起こるかな〜と想像した結果です。問題の箇所の指摘ではありません。
■4
＞手動で月曜日F5 火曜日F5・・・で実行していくと上手くいくんですよねー
よくわからないけど、半平太さんが指摘されたActiveSheetのほかにselectionなどがコードに入っているんじゃないかと想像します。
＞もう解決しましたので、大丈夫なんですが、、、
好きにすればよいとはおもいますけど、今からでもコードを提示して添削してもらってみたらどうでしょうか？
場合によっては、もっと効率的な方法を教えてもらえるかもしれませんし、特に直すような箇所がなくとも、提示することで同じような悩みを持つ方の参考になるかとおもいます。
（もこな２） 2019/09/15(日) 16:53
コードの修正ではなく、CALLで呼び出した時だけ上手くいかないって事はあるのでしょうか？
という質問をしたかったんです！
回りくどい書き方してごめんなさい。
一応、何も変えずに7個のプログラムだけをF5していったつもりですが、、確認作業がだいぶ曖昧だったと思います！
ステップ実行を上手く使って確認していきたいと思います。
コードについては載せないつもりです。
不快にさせてしまって申し訳ありません。
（なのれい） 2019/09/15(日) 19:43
＞改良したコードありますのでそちらを添削して頂いてもよろしいでしょうか？
いいんじゃないですか？ 個人的にも見てみたいです
（渡辺ひかる） 2019/09/15(日) 19:59
夜遅くになるかもしれませんが、載せたいと思います！
宜しくお願い致します！
（なのれい） 2019/09/15(日) 20:02
https://gyazo.com/163cff9e66c27649b920784a0d878bed
固定シフト
固定シフトを作成シートに反映させるのが今の目的です。
・入替のシフトを●の前日に反映
・曜日のシフトを作成シフトに反映
・サイクルのシフトは真ん中の公を基準にして、作成シートで公を探しその前後二日を固定シフトのように反映させる
説明足らなかったらすみません。
一応、思い通りに動いて下記の画像になります。
https://gyazo.com/2e801e4b8baae4d6ccaaefa899047643
コード
Sub 入替日､サイクル､曜日()
Dim i As Long
Dim j As Long
Dim k As Long
Dim 名前の行 As Long
Dim 入替シフト As String
Dim 名前 As String
Dim シフト As String
Dim シフト1前 As String
Dim シフト2前 As String
Dim シフト1後 As String
Dim シフト2後 As String
Dim 月曜 As String
Dim 火曜 As String
Dim 水曜 As String
Dim 木曜 As String
Dim 金曜 As String
Dim 土曜 As String
Dim 日曜 As String
Dim MaxRow As Long Dim MaxColumns As Long
MaxRow = Range("C6").End(xlDown).Row
MaxColumns = Cells(4, Columns.Count).End(xlToLeft).Column
For i = 7 To MaxRow
名前 = Range("C" & i).Value
Worksheets("固定シフト").Activate
名前の行 = Range("A:A").Find(名前).Row
入替シフト = Range("B" & 名前の行).Value
シフト = Range("N" & 名前の行).Value
シフト1前 = Range("M" & 名前の行).Value
シフト2前 = Range("L" & 名前の行).Value
シフト1後 = Range("O" & 名前の行).Value
シフト2後 = Range("P" & 名前の行).Value
月曜 = Range("D" & 名前の行).Value
火曜 = Range("E" & 名前の行).Value
水曜 = Range("F" & 名前の行).Value
木曜 = Range("G" & 名前の行).Value
金曜 = Range("H" & 名前の行).Value
土曜 = Range("I" & 名前の行).Value
日曜 = Range("J" & 名前の行).Value
Worksheets("作成シート").Activate
For j = 8 To MaxColumns + 1
If Cells(6, j) <> "" Then
If Cells(i, j - 1) <> "" Then
Else
Cells(i, j - 1).Value = 入替シフト
End If
Else
End If
If Cells(5, j) = "月" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 月曜
End If
Else
If Cells(5, j) = "火" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 火曜
End If
Else
If Cells(5, j) = "水" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 水曜
End If
Else
If Cells(5, j) = "木" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 木曜
End If
Else
If Cells(5, j) = "金" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 金曜
End If
Else
If Cells(5, j) = "土" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 土曜
End If
Else
If Cells(5, j) = "日" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 日曜
End If
Else
End If
End If
End If
End If
End If
End If
End If
Next j
For k = 7 To MaxColumns
If Cells(i, k) = シフト Then
If Cells(i, k - 1) = "" Or Cells(i, k - 1) = "出" Then
Cells(i, k - 1).Value = シフト1前
Else
End If
If Cells(i, k - 2) = "" Or Cells(i, k - 2) = "出" Then
Cells(i, k - 2).Value = シフト2前
Else
End If
If Cells(i, k + 1) = "" Or Cells(i, k + 1) = "出" Then
Cells(i, k + 1).Value = シフト1後
Else
End If
If Cells(i, k + 2) = "" Or Cells(i, k + 2) = "出" Then
Cells(i, k + 2).Value = シフト2後
Else
End If
Else
End If
Next k
Next i
End Sub
（なのれい） 2019/09/15(日) 23:44
(1) そのコードは標準モジュールに書いてあるとの理解でよいですか？
(2) (1)がYESの場合、マクロの実行前はどのシートがアクティブになってますか？
(3) Select case ステートメントはご存知ですか？
（もこな２） 2019/09/16(月) 00:02
すみません。よろしくお願いします。
（なのれい） 2019/09/16(月) 00:23
Sub 入替日､サイクル､曜日()
Dim i As Long, j As Long, k As Long, 名前の行 As Long
Dim 入替シフト As String, 名前 As String, シフト As String
Dim シフト1前 As String, シフト2前 As String, シフト1後 As String, シフト2後 As String
Dim 月曜 As String, 火曜 As String, 水曜 As String, 木曜 As String, 金曜 As String, 土曜 As String, 日曜 As String
Dim MaxRow As Long
Dim MaxColumns As Long
MaxRow = Range("C6").End(xlDown).Row
MaxColumns = Cells(4, Columns.Count).End(xlToLeft).Column
For i = 7 To MaxRow
名前 = Range("C" & i).Value
Worksheets("固定シフト").Activate
名前の行 = Range("A:A").Find(名前).Row
入替シフト = Range("B" & 名前の行).Value
シフト = Range("N" & 名前の行).Value
シフト1前 = Range("M" & 名前の行).Value
シフト2前 = Range("L" & 名前の行).Value
シフト1後 = Range("O" & 名前の行).Value
シフト2後 = Range("P" & 名前の行).Value
月曜 = Range("D" & 名前の行).Value
火曜 = Range("E" & 名前の行).Value
水曜 = Range("F" & 名前の行).Value
木曜 = Range("G" & 名前の行).Value
金曜 = Range("H" & 名前の行).Value
土曜 = Range("I" & 名前の行).Value
日曜 = Range("J" & 名前の行).Value
Worksheets("作成シート").Activate
For j = 8 To MaxColumns + 1
If Cells(6, j) <> "" Then
If Cells(i, j - 1) <> "" Then
Else
Cells(i, j - 1).Value = 入替シフト
End If
Else
End If
If Cells(5, j) = "月" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 月曜
End If
Else
If Cells(5, j) = "火" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 火曜
End If
Else
If Cells(5, j) = "水" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 水曜
End If
Else
If Cells(5, j) = "木" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 木曜
End If
Else
If Cells(5, j) = "金" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 金曜
End If
Else
If Cells(5, j) = "土" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 土曜
End If
Else
If Cells(5, j) = "日" Then
If Cells(i, j) <> "" Then
Else
Cells(i, j).Value = 日曜
End If
Else
End If
End If
End If
End If
End If
End If
End If
Next j
For k = 7 To MaxColumns
If Cells(i, k) = シフト Then
If Cells(i, k - 1) = "" Or Cells(i, k - 1) = "出" Then
Cells(i, k - 1).Value = シフト1前
Else
End If
If Cells(i, k - 2) = "" Or Cells(i, k - 2) = "出" Then
Cells(i, k - 2).Value = シフト2前
Else
End If
If Cells(i, k + 1) = "" Or Cells(i, k + 1) = "出" Then
Cells(i, k + 1).Value = シフト1後
Else
End If
If Cells(i, k + 2) = "" Or Cells(i, k + 2) = "出" Then
Cells(i, k + 2).Value = シフト2後
Else
End If
Else
End If
Next k
Next i
End Sub
とりあえず。
(★1)ActiveSheetに依存するコードを改善しましょう。 [[20190808050847]] 『シート間のコピペについて』（なのれい） >>BOT ↑の（もこな２） 2019/08/09(金) 02:02の◆２を読み返してください
(★2)IFステートメントの記述について、ややこしくなるので単純に記述しましょう [[20190205234302]] 『下記のコードをループさせたいのです』（なのれい） ↑の（もこな２） 2019/02/08(金) 06:35の１点目として〜を読み返してください。
（もこな２） 2019/09/16(月) 00:43
修正して、再度載せます！
（なのれい） 2019/09/16(月) 00:55
(★3)select case の採用
↓のように同じ判定条件で複数に分岐させたいようなので、Select Case を使うとよいと思います。
If Cells(5, j) = "月" Then
If Cells(5, j) = "火" Then
If Cells(5, j) = "水" Then
・
・
・
Sub さんぷる()
Const 曜日 As String = "日"
Select Case 曜日
Case Is = "月": MsgBox "月曜です"
Case Is = "火": MsgBox "火曜です"
Case Is = "水": MsgBox "水曜です"
Case Else: MsgBox "月〜水ではありません"
End Select
End Sub
【参考】 https://excel-master.net/macro-vba/excel-vba-if-select-case-proper-use/ http://officetanaka.net/excel/vba/statement/SelectCase.htm
他に気になるところはありますが、いっぺんに言っても混乱するとおもうので、とりあえず私からはこのくらいにして、提示のコードを私が改造すると↓みたいな感じになりました。
ステップ実行して研究の上、使えそうな部分があればご自身のコードに組み込んでみてください。
※コンパイルエラーにならないことしか確認してません。注意！！
Sub 入替日､サイクル､曜日_改造()
Dim i As Long, j As Long, k As Long, 名前の行 As Long
Dim 入替シフト As String, 名前 As String, シフト As String
Dim シフト1前 As String, シフト2前 As String, シフト1後 As String, シフト2後 As String
Dim MyRNG As Range
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
名前 = .Range("C" & i).Value
With Worksheets("固定シフト")
名前の行 = .Range("A:A").Find(名前).Row
入替シフト = .Range("B" & 名前の行).Value
シフト = .Range("N" & 名前の行).Value
シフト1前 = .Range("M" & 名前の行).Value
シフト2前 = .Range("L" & 名前の行).Value
シフト1後 = .Range("O" & 名前の行).Value
シフト2後 = .Range("P" & 名前の行).Value
'▼セル範囲を覚える
Set MyRNG = .Cells(名前の行, "D").Resize(, 7)
End With
For j = 8 To .Cells(4, .Columns.Count).End(xlToLeft).Column + 1
If .Cells(6, j) <> "" Then
If .Cells(i, j - 1) = "" Then .Cells(i, j - 1).Value = 入替シフト
End If
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(1).Value
Case Is = "火"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(2).Value
Case Is = "水"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(3).Value
Case Is = "木"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(4).Value
Case Is = "金"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(5).Value
Case Is = "土"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(6).Value
Case Is = "日"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(7).Value
Case Else
MsgBox "エラー：" & .Cells(5, j).Address(0, 0) & "セルの値が月〜日ではありません"
Exit Sub
End Select
Next j
For k = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(i, k) = シフト Then
If .Cells(i, k - 1) = "" Or .Cells(i, k - 1) = "出" Then
.Cells(i, k - 1).Value = シフト1前
End If
If .Cells(i, k - 2) = "" Or .Cells(i, k - 2) = "出" Then
.Cells(i, k - 2).Value = シフト2前
End If
If .Cells(i, k + 1) = "" Or .Cells(i, k + 1) = "出" Then
.Cells(i, k + 1).Value = シフト1後
End If
If .Cells(i, k + 2) = "" Or .Cells(i, k + 2) = "出" Then
.Cells(i, k + 2).Value = シフト2後
End If
End If
Next k
Next i
End With
End Sub
（もこな２） 2019/09/16(月) 02:23
Sub 入替日､サイクル､曜日_改()
Dim tmp As Long
（中略）
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月", "火", "水", "木", "金", "土", "日"
tmp = Application.Match(.Cells(5, j).Value, Array("月", "火", "水", "木", "金", "土", "日"), 0)
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(tmp).Value
Case Else
MsgBox "エラー：" & .Cells(5, j).Address(0, 0) & "セルの値が月〜日ではありません"
Exit Sub
End Select
（中略）
End Sub
（もこな２） 2019/09/16(月) 02:31
コードがとても簡略化されてて分かりやすいです。
気になった点を下記に記載致しますので確認して頂けないでしょうか？
1、With Worksheets("固定シフト")を使用し、現在コードがどこの処理をしようとしているのか明確にすること。
2、Set MyRNG = .Cells(名前の行, "D").Resize(, 7)の意味について、名前の行とＤ列を1として覚える。Resizeが0,7なのでさっきのセルを1として右に7まで移動した所まで覚える。
とりあえずここを理解出来たと思っております。
理解するの遅くて申し訳ありません。ちゃんと覚えていく気持ちはありますので、まだまだ指摘宜しくお願い致します。
コードはほとんど使わせて頂きます。ありがとうございます。
Sub 入替日､サイクル､曜日_改造()
Dim i As Long, j As Long, k As Long, 名前の行 As Long
Dim 入替シフト As String, 名前 As String, シフト As String
Dim シフト1前 As String, シフト2前 As String, シフト1後 As String, シフト2後 As String
Dim MyRNG As Range
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
名前 = .Range("C" & i).Value
With Worksheets("固定シフト")
名前の行 = .Range("A:A").Find(名前).Row
入替シフト = .Range("B" & 名前の行).Value
シフト = .Range("N" & 名前の行).Value
シフト1前 = .Range("M" & 名前の行).Value
シフト2前 = .Range("L" & 名前の行).Value
シフト1後 = .Range("O" & 名前の行).Value
シフト2後 = .Range("P" & 名前の行).Value
'▼セル範囲を覚える
Set MyRNG = .Cells(名前の行, "D").Resize(, 7)
End With
For j = 8 To .Cells(4, .Columns.Count).End(xlToLeft).Column + 1
If .Cells(6, j) <> "" Then
If .Cells(i, j - 1) = "" Then .Cells(i, j - 1).Value = 入替シフト
End If
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(1).Value
Case Is = "火"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(2).Value
Case Is = "水"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(3).Value
Case Is = "木"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(4).Value
Case Is = "金"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(5).Value
Case Is = "土"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(6).Value
Case Is = "日"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(7).Value
Case Else
End Select
Next j
For k = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(i, k) = シフト Then
If .Cells(i, k - 1) = "" Or .Cells(i, k - 1) = "出" Then
.Cells(i, k - 1).Value = シフト1前
End If
If .Cells(i, k - 2) = "" Or .Cells(i, k - 2) = "出" Then
.Cells(i, k - 2).Value = シフト2前
End If
If .Cells(i, k + 1) = "" Or .Cells(i, k + 1) = "出" Then
.Cells(i, k + 1).Value = シフト1後
End If
If .Cells(i, k + 2) = "" Or .Cells(i, k + 2) = "出" Then
.Cells(i, k + 2).Value = シフト2後
End If
End If
Next k
Next i
End With
End Sub
（なのれい） 2019/09/16(月) 16:22
＞1、With Worksheets("固定シフト")を使用し、現在コードがどこの処理をしようとしているのか明確にすること。
処理の考え方としては、どのブックの、どのシートの、どのセルかまで、
明確にしたほうが、意図しない動作は起きにくいです。
特に標準モジュールに記述した場合、指定がないとActiveなオブジェクトになります。
元々Callで呼び出した際も、処理の連続でActiveSheetが意図しないものになっていたのではないでしょうか。
ちなみに、With Worksheets("固定シフト")の場合、ブックを複数開いていた場合、かつ同じシート名のシートが存在すると、Activeなブック側で処理されてしまいます。
ThisWorkbookを先頭に付け加えるといいかと。
私もまだまだですが、覚えるといろいろ出来るのでがんばってください。
（tkit） 2019/09/16(月) 16:56
了解しました。ありがとうございます。
（なのれい） 2019/09/16(月) 17:09
掲示頂いたので 私なりに添削 多分 同じ動作をすると思います もう少し、改善できると思いますが リンク先は見ていません
Sub 入替日､サイクル､曜日()
Dim i As Long
Dim j As Long
Dim k As Long
Dim 名前の行 As Long
Dim 入替シフト As String
Dim 名前 As String
Dim シフト As String
Dim シフト1前 As String
Dim シフト2前 As String
Dim シフト1後 As String
Dim シフト2後 As String
Dim MaxRow As Long
Dim MaxColumns As Long
Dim my作成Sht As Worksheet
Dim my固定シフト As Worksheet
Set my作成Sht = Worksheets("作成シート")
Set my固定シフト = Worksheets("固定シフト")
With my作成Sht
MaxRow = .Range("C6").End(xlDown).Row
MaxColumns = .Cells(4, Columns.Count).End(xlToLeft).Column
For i = 7 To MaxRow
名前 = .Range("C" & i).Value
With my固定シフト
名前の行 = .Range("A:A").Find(名前).Row
入替シフト = .Range("B" & 名前の行).Value
シフト = .Range("N" & 名前の行).Value
シフト1前 = .Range("M" & 名前の行).Value
シフト2前 = .Range("L" & 名前の行).Value
シフト1後 = .Range("O" & 名前の行).Value
シフト2後 = .Range("P" & 名前の行).Value
End With
For j = 8 To MaxColumns + 1
If .Cells(6, j) <> "" And .Cells(i, j - 1) = "" Then .Cells(i, j - 1).Value = 入替シフト
If Len(.Cells(5, j).Value) = 1 And InStr(1, "月火水木金土日", .Cells(5, j).Value) > 0 And .Cells(i, j) = "" Then
.Cells(i, j).Value = my固定シフト.Range("C" & 名前の行).Offset(, InStr(1, "月火水木金土日", .Cells(5, j).Value)).Value
End If
Next j
For k = 7 To MaxColumns
If .Cells(i, k) = シフト Then
With .Cells(i, k - 1)
If .Value = "" Or .Value = "出" Then .Value = シフト1前
End With
With .Cells(i, k - 2)
If .Value = "" Or .Value = "出" Then .Value = シフト2前
End With
With .Cells(i, k + 1)
If .Value = "" Or .Value = "出" Then .Value = シフト1後
End With
With .Cells(i, k + 2)
If .Value = "" Or .Value = "出" Then .Value = シフト2後
End With
End If
Next k
Next i
End With
End Sub
（渡辺ひかる） 2019/09/16(月) 19:34
添削頂きありがとうございます。
With .Cells(i, k - 1) If .Value = "" Or .Value = "出" Then .Value = シフト1前 End With
このWith を使って無駄にセルの選択するコードを簡略化してるんですね。
曜日の所のコードは理解出来てないので頑張って勉強します。
ありがとうございます。
（なのれい） 2019/09/16(月) 19:56
(★4)Withステートメントについて
＞1、With Worksheets("固定シフト")を使用し、現在コードが
＞どこの処理をしようとしているのか明確にすること。
ちょっと誤解があるかもです
問題なのは、↓のようになっちゃってるところです。
シフト = ActiveSheet.Range("N" & 名前の行).Value
明確にしたほうがよいのは、Rangeオブジェクトの親オブジェクトですから、Withに拘らずとも
シフト = Worksheets("固定シフト").Range("N" & 名前の行).Value
Dim SH As Worksheet
set SH = Worksheets("固定シフト").Range("N" & 名前の行).Value
シフト = SH.Range("N" & 名前の行).Value
などとしてもよいです。
ただ、Withステートメントを使ったほうが記述が楽だとおもったので紹介した次第です。
そもそも、Withってなんだ？という場合は↓が参考になりそうです。
http://officetanaka.net/excel/vba/beginner/16.htm
(★5)Resizeプロパティについて
大体その理解であってるとおもいますが、参考URLを紹介しておきます。
https://excel-ubara.com/excelvba1/EXCELVBA382.html
https://www.moug.net/tech/exvba/0050058.html
https://kosapi.com/post-1281/
ちなみに、無理にResizeプロパティを使わなくてもいろんな方法があります。
Sub さんぷる()
Dim 発見セル As Range
Dim 名前の行 As Long
With Worksheets("固定シフト")
Set 発見セル = .Range("A:A").Find("鈴木")
名前の行 = 発見セル.Row
'▼Resizeプロパティを使う（現状）
Debug.Print .Cells(名前の行, "D").Resize(, 7).Address(0, 0)
'▼セル番地を文字列で表現する
Debug.Print .Range("D" & 名前の行 & ":J" & 名前の行).Address(0, 0)
'▼Range1、Range2を指定する
Debug.Print .Range(.Cells(名前の行, "D"), .Cells(名前の行, "J")).Address(0, 0)
'▼Intersectメソッドを使う
Debug.Print Intersect(発見セル.EntireRow, .Range("D:J")).Address(0, 0)
End With
End Sub
(★6)Findメソッドについて
[[20190205234302]] 『下記のコードをループさせたいのです』（なのれい）
↑でも言及しましたが、Findメソッドは、省略した場合、前回値を引き継ぐ引数があります。
したがって、↓のような記述をすると場合によっては見つからず「Nothing」になる可能性があります。
Range("A:A").Find(名前)
そうなると、見つからなかった場合「Nothing.Row」を求めようとすることになり、以前説明したとおりNothingはセル（Rangeオブジェクト）ではありませんから、この部分で実行時エラーが発生します。
また、当たり前ですが引数をちゃんと指定した場合でも、目的のセルが見つからなければ「Nothing」になります。
したがって、繰り返しになりますが、Findメソッドを使うなら、引数をちゃんと指定したうえで見つからなかった場合にも実行時エラーにならないようにしたほうがよいとおもいます。
また、当該トピックで触れましたが、行"番号"を求めたいならFindメソッドではなく、MATCH関数を使うという手もありますね。
(★7)シフト関係について
よく見ると、↓のようになってますからA〜P列まで一気にMyRNGに含めるのも手ですね。
入替シフト → B列 → 2列目
月曜 → D列 → 4列目 火曜 → E列 → 5列目 水曜 → F列 → 6列目 木曜 → G列 → 7列目 金曜 → H列 → 8列目 土曜 → I列 → 9列目 日曜 → J列 →10列目
シフト2前 → L列 →12列目 シフト1前 → M列 →13列目 シフト → N列 →14列目 シフト1後 → O列 →15列目 シフト2後 → P列 →16列目
（もこな２） 2019/09/17(火) 04:16
＞このWith を使って無駄にセルの選択するコードを簡略化してるんですね。
その通りですが
＞シフト = .Range("N" & 名前の行).Value
＞シフト1前 = .Range("M" & 名前の行).Value
＞シフト2前 = .Range("L" & 名前の行).Value
＞シフト1後 = .Range("O" & 名前の行).Value
＞シフト2後 = .Range("P" & 名前の行).Value
この辺は 連続したセル範囲のようなので、配列化できれば、 最後の部分も含めて、もっとすっきりしたコードになります
＞ 曜日の所のコードは理解出来てないので頑張って勉強します。
これ 元データが 曜日一文字を含んでいるかどうかを Instr 関数で判断し、含んでいれば その位置を使ってで、次の処理をしています。 IFの入れ子が一週間分あったので、それを回避するためです。
（渡辺ひかる） 2019/09/17(火) 09:52
手動で実行すれば、次のプロシージャの実行まで0.1秒くらい間が空くと思います。
自動で実行すれば、すごい速さで次々と命令が実行されます。
ですが、エクセル君が少し時間がかかる処理をしている間に次々命令されても、
処理が間に合わなくてエラーになる場合があります。
また、画面の更新が間に合わなくて、
「うまくいかなかった。」ように見える現象も、自分の使っているパソコンでは見られます。
それらは、一概にはいえないので、実験して現象を確認してみないと何ともコメントできません。
（まっつわん） 2019/09/17(火) 13:30
【誤】
Dim SH As Worksheet
set SH = Worksheets("固定シフト").Range("N" & 名前の行).Value
シフト = SH.Range("N" & 名前の行).Value
↓
【正】
Dim SH As Worksheet
set SH = Worksheets("固定シフト")
シフト = SH.Range("N" & 名前の行).Value
（もこな２） 2019/09/17(火) 18:17
（PTA） 2019/09/17(火) 20:40
つまんない事を書いてしまったと思ったので、自己削除しました。
ごめんなさい m(__)m
（半平太） 2019/09/17(火) 20:43
Sub Sub1()
Range("A1:C1").ClearContents
Range("B1").Formula = "=A1/2"
Range("A1").Value = 10
End Sub
Sub Sub2()
Range("C1").Value = Range("A1").Value / Range("B1").Value
End Sub
Sub Test1()
Application.Calculation = xlCalculationAutomatic
Call Sub1
Call Sub2
End Sub
Sub Test2()
On Error GoTo Trap
Application.Calculation = xlCalculationManual
Call Sub1
Call Sub2
Trap:
Application.Calculation = xlCalculationAutomatic
End Sub
（チオチモリン） 2019/09/17(火) 22:54
【固定シフト】シートのほうは、一部推測補完するとこんな感じのようです。
______Ａ___Ｂ___Ｃ__Ｄ__Ｅ__Ｆ__Ｇ__Ｈ__Ｉ__Ｊ__ｋ__Ｌ___Ｍ____Ｎ___Ｏ___Ｐ_____ 1 名前 入替 │-------曜日休み-------│ │------サイクル-----│ 2 月 火 水 木 金 土 日
3 田中 B A 公 出 A 公 B 出 4 鈴木 B B 出 出 A 公 B 出 5 中野 B C 公 出 A 公 B 出 6 佐藤 B 中 出 A 公 B 出
（もこな２） 2019/09/17(火) 23:55
理解力が乏しいので一つずつ頑張って覚えていきたいと思います。
今回のもこな2さんから提案頂いたコードをもう一度修正かけて提示致しますので、宜しくお願い致します。
あと、リンク貼り付け行為はあまりよろしくないのでしょうか？
（なのれい） 2019/09/18(水) 01:22
＞リンク貼り付け行為〜
この掲示板では禁止してないようですが、セキュリティ等の観点から見ない方針の方はいらっしゃいますね。
また、将来にトピックを見返したときにリンク切れになってしまい話が見えなくなるリスクもあるとおもいます。
（もこな２） 2019/09/18(水) 12:23
修正点
・（もこな２） 2019/09/17(火) 23:55の図でＣ列とＫ列を削除しましたのでそこの部分のコード変更をしました。
・Set MyRNG = .Cells(名前の行, "B").Resize(, 13)を利用し、曜日以外の所も簡略化しました。
気になる点
・名前の行 = .Range("A:A").Find(名前).Rowの部分で名前が見つからなかった場合の事を考える必要がある？
Sub 入替日､サイクル､曜日_改造3()
Dim i As Long, j As Long, k As Long, 名前の行 As Long
Dim 名前 As String, シフト As String
Dim MyRNG As Range
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
名前 = .Range("C" & i).Value
With Worksheets("固定シフト")
名前の行 = .Range("A:A").Find(名前).Row
シフト = .Range("L" & 名前の行).Value
'▼セル範囲を覚える
Set MyRNG = .Cells(名前の行, "B").Resize(, 13)
End With
For j = 8 To .Cells(4, .Columns.Count).End(xlToLeft).Column + 1
If .Cells(6, j) <> "" Then
If .Cells(i, j - 1) = "" Then .Cells(i, j - 1).Value = MyRNG.Cells(1).Value
End If
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(2).Value
Case Is = "火"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(3).Value
Case Is = "水"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(4).Value
Case Is = "木"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(5).Value
Case Is = "金"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(6).Value
Case Is = "土"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(7).Value
Case Is = "日"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(8).Value
Case Else
End Select
Next j
For k = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(i, k) = シフト Then
If .Cells(i, k - 1) = "" Or .Cells(i, k - 1) = "出" Then
.Cells(i, k - 1).Value = MyRNG.Cells(10).Value
End If
If .Cells(i, k - 2) = "" Or .Cells(i, k - 2) = "出" Then
.Cells(i, k - 2).Value = MyRNG.Cells(9).Value
End If
If .Cells(i, k + 1) = "" Or .Cells(i, k + 1) = "出" Then
.Cells(i, k + 1).Value = MyRNG.Cells(12).Value
End If
If .Cells(i, k + 2) = "" Or .Cells(i, k + 2) = "出" Then
.Cells(i, k + 2).Value = MyRNG.Cells(13).Value
End If
End If
Next k
Next i
End With
End Sub
（なのれい） 2019/09/19(木) 04:23
（★９）
＞Set MyRNG = .Cells(名前の行, "B").Resize(, 13)を利用し、曜日以外の所も簡略化しました。
それって↓みたいになってるんですよね？
With Worksheets("固定シフト")
名前の行 = .Range("A:A").Find(名前).Row
Set MyRNG = .Cells(名前の行, "B").Resize(, 13)
End With
以前も言いましたが、Findメソッドは発見した場合【セル】（Rangeオブジェクト）を返すのですから、↓でも同じことですよね
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前).Offset(,1).Resize(, 13)
＞気になる点
＞・名前の行 = .Range("A:A").Find(名前).Rowの部分で名前が見つからなかった場合の事を考える必要がある？
上記と同じトピックで言及してますが、逆に【見つからなかった場合】Nothingになるのですから、Rangeオブジェクトとして扱うことはできません。
要は↓のようになって実行時エラーが発生する。 Nothing.Row Nothing.Offset(,1).Resize(, 13)
なので、検索値が”無かった”場合の処理を考えないと、エラー停止する可能性がありますよと指摘したつもりです。
（もこな２） 2019/09/19(木) 20:47
2019/09/20 7:46 体裁を微修正
まずテキストで再現しました。
Ａ B C D E F G H I J K L M N 1 入替 曜日休み サイクル 2 月 火 水 木 金 土 日 前々 前 ベース 後 後々 3 氏名 出 A 公 B 出 4 氏名 出 A 公 B 出 5 氏名 出 A 公 B 出 6 氏名 出 A 公 B 出 7 氏名 8 氏名 出 A 公 B 出 9 氏名 出 A 公 B 出 10 氏名 出 A 公 B 出 11 氏名 出 A 公 B 出 12 氏名 13 氏名 14 氏名 出 出 出 A 公 B 出 15 氏名 出 出 出 A 公 B 出 16 氏名 公 公 17 氏名 18 氏名 出 A 公 B 出 19 氏名 出 A 公 B 出 20 氏名 21 氏名 C C C C C 公 22 氏名 C C 公 C C C 23 氏名 C C C 公 C C
（なのれい） 2019/09/20(金) 11:57
この部分も理解しコードに組み込めました。
変数の宣言の部分とwithとend withの行などを3行程短縮出来ました。
ありがとうございます。
（なのれい） 2019/09/20(金) 12:13
（もこな２） 2019/09/20(金) 18:46
（もこな２） 2019/09/21(土) 00:37
【固定シフト】シート
____A____B_____C___D___E___F___G___H___I______J______K______L_____M______N____
1 指名 入替 +++++++++曜日休み+++++++++ +++++++++++サイクル+++++++++++
2 ++++ ++++ 月 火 水 木 金 土 日 前々 前 ベース 後 後々
3 相田 出 A 公 B 出 4 石田 5 植木 出 出 出 A 公 B 出 6 江本 公 公 7 織田 出 A 公 B 出 8 金本 C C C C C 公 9 木本 C C 公 C C C 10 工藤 C C C 公 C C
もうわかってると思いますが、↑みたいな感じの時に"佐藤"さんを探しても居ないから現状のコードだとエラー停止しますよね。
（もこな２） 2019/09/21(土) 01:26
_C_____D___E_______H___I___J___K___L___M___N___O___P___Q___R___S___..__AL_______
5 2019 10 月 1 2 3 4 5 6 7 8 9 10 11 12 31
6 名前 火 水 木 金 土 日 月 火 水 木 金 土 木
7 相田 ● 8 佐藤 9 植木 10 織田 11 工藤
確認ですけど、H5セルより右のセルの値は、シリアル値ですか？
もしシリアル値ならば、6行目の"文字"で判定しなくても、5行目だけで何曜日かわかりますね。
（もこな２） 2019/09/21(土) 03:11
Sub 研究用1()
Dim i As Long, j As Long, k As Long
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
For j = 8 To .Cells(4, .Columns.Count).End(xlToLeft).Column + 1
Debug.Print .Cells(i, j).Address(0, 0)
Next j
For k = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
Debug.Print .Cells(i, k).Address(0, 0)
Next k
Next i
End With
End Sub
↓でも同じことですよね。
Sub 研究用2()
Dim i As Long, j As Long
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
For j = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
Debug.Print .Cells(i, j).Offset(, 1).Address(0, 0)
Debug.Print .Cells(i, j).Address(0, 0)
Next k
Next i
End With
End Sub
（もこな２） 2019/09/21(土) 03:37
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前)
If MyRNG Is Nothing Then
上記の場合だとNothingの判定をしてくれています。
しかし下記のコードの場合は上手く行かないです。
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前).Offset(, 9).Resize(, 5)
If MyRNG Is Nothing Then
ここまでは分かったんですけど、次どうすればいいのかはまだ分かっていない状態です。
（なのれい） 2019/09/22(日) 04:34
=TEXT(C4&"/"&D4&"/"&H4,"aaa")
の関数を利用しております。
（なのれい） 2019/09/22(日) 04:38
(6, j + 1)で解決出来たと思います。
ありがとうございます。
Sub 固定シフト反映()
Dim i As Long, j As Long, k As Long, 名前の行 As Long
Dim 名前 As String, シフト As String
Dim MyRNG As Range
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
名前 = .Range("C" & i).Value
With Worksheets("固定シフト")
名前の行 = .Range("A:A").Find(名前).Row
シフト = .Range("L" & 名前の行).Value
'▼セル範囲を覚える
Set MyRNG = .Cells(名前の行, "B").Resize(, 13)
End With
For j = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(6, j + 1) <> "" Then
If .Cells(i, j) = "" Then .Cells(i, j).Value = MyRNG.Cells(1).Value
End If
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(2).Value
Case Is = "火"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(3).Value
Case Is = "水"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(4).Value
Case Is = "木"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(5).Value
Case Is = "金"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(6).Value
Case Is = "土"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(7).Value
Case Is = "日"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(8).Value
Case Else
End Select
If .Cells(i, j) = シフト Then
If .Cells(i, j - 1) = "" Or .Cells(i, j - 1) = "出" Then
.Cells(i, j - 1).Value = MyRNG.Cells(10).Value
End If
If .Cells(i, j - 2) = "" Or .Cells(i, j - 2) = "出" Then
.Cells(i, j - 2).Value = MyRNG.Cells(9).Value
End If
If .Cells(i, j + 1) = "" Or .Cells(i, j + 1) = "出" Then
.Cells(i, j + 1).Value = MyRNG.Cells(12).Value
End If
If .Cells(i, j + 2) = "" Or .Cells(i, j + 2) = "出" Then
.Cells(i, j + 2).Value = MyRNG.Cells(13).Value
End If
End If
Next j
Next i
End With
End Sub
（なのれい） 2019/09/22(日) 04:55
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前).Offset(, 9).Resize(, 5)
If MyRNG Is Nothing Then
Findメソッドは、Rangeオブジェクトそのものを返します。
上手くいくパターンは、MyRNGにValue値が"名前"のセルそのものが格納されます。
見つからない場合は、何も格納されないのでNothingとなります。
ステッップ実行時、ローカルウィンドウでMyRNGの値を確認すれば、理解できると思います。
宣言しただけでは、空の状態ですのでNothingです。
OffsetやResizeは、Rangeオブジェクトに対して行うので、Value値が"名前"のセルが無い場合、
当然MyRNGは空ですので、エラーになりますよね。
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前)
If MyRNG Is Nothing Then
Set MyRNG= MyRNG.Offset(, 9).Resize(, 5)
ローカルウィンドウで変数の中身がどうなっているか確認できますので、
確認してみてくださいね。
（tkit） 2019/09/22(日) 07:50
好みの問題だし好きにすればいいと思いますが
H5 =DATE(C5,D5,1)
I5 =IFERROR(IF(EOMONTH(H5,0)=EOMONTH(H5+1,0),H5+1,""),"") 【表示形式】をdに変更 ↑をAL列までフィルコピー
H6 =IF(H5="","",H5) 【表示形式】をaaaに変更 ↑をAL列までフィルコピー
でも良さそうな、、、
このようにしておくと、【シリアル値】から曜日を（１〜７の数値で）求めることが出来ます。
Sub 実験3()
Debug.Print Weekday("2019/9/22", vbMonday)
End Sub
（★12）
＞やっと理解出来ました！
ほんとかなぁ・・・
tkitさんの説明は↓だと、エラーになることがありますよ。って言ってると思いますけど・・・
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前)
If MyRNG Is Nothing Then
Set MyRNG= MyRNG.Offset(, 9).Resize(, 5)
1行目 Findメソッドで見つからない場合→MyRNGに「Nothing」が格納される 2行目 MyRNGに「Nothing」が格納されていたらTrueと判定 3行目 「Nothing」をOffsetしようとしてるから実行時エラー
ちなみに、（★9）で同じこと言ってませんかね。。。
なお、↓だったらエラーにはならないですが、引数を省略しているから、場合によっては、ちゃんとあるのに処理されない問題が発生するかもですね。
(★6)で指摘済み
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(名前)
If Not MyRNG Is Nothing Then
Set MyRNG= MyRNG.Offset(, 9).Resize(, 5)
'さまざまな処理
End if
（もこな２） 2019/09/22(日) 12:38
もっかい考え直してきます！！！
（なのれい） 2019/09/22(日) 13:03
If MyRNG Is Nothing Then
Else
Set MyRNG = MyRNG.Offset(, 9).Resize(, 5)
さまざまな処理
End if
Next i
これで上手くいくと思うんですがどうでしょうか？
・名前が見つからなかったらNothing判定になり、次の行の氏名を探しに行く。もしみつかれば、名前から右に9つ移動したセルから5個セルを取得する。
いかがでしょうか？
（なのれい） 2019/09/22(日) 19:20
If 条件式1 Then
条件式1を満たした場合の処理
ElseIf 条件式2 Then
条件式2を満たした場合の処理
Else
条件式1と条件式2を満たさなかった場合の処理
End If
（PTA） 2019/09/22(日) 19:55
＞Find(名前) 名前はどうやって入力しているんですか。 （kill） 2019/09/22(日) 20:23
ちなみに私的には"文法"の誤りとまでは言わないですが、
If 条件 Else 'Else節 End If
↓
IF Not 条件 'True節 End If
としますね。（ちなみにこの話（★2）で言ってます。）
また、相変わらず引数省略してますけど大丈夫ですか？（といいつつ、今回は問題おきなさそうな気がしてきましたが・・）
（もこな２） 2019/09/22(日) 20:24
もう一度書き直してきます！！！
何度も申し訳ありません！
（なのれい） 2019/09/22(日) 21:04
Dim i As Long, j As Long
Dim 名前 As String
Dim MyRNG As Range
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
名前 = .Range("C" & i).Value
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(What:=名前, LookAt:=xlWhole)
If Not (MyRNG Is Nothing) Then
Set MyRNG = MyRNG.Offset(, 1).Resize(, 13)
For j = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(6, j + 1) <> "" Then
If .Cells(i, j) = "" Then .Cells(i, j).Value = MyRNG.Cells(1).Value
End If
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(2).Value
Case Is = "火"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(3).Value
Case Is = "水"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(4).Value
Case Is = "木"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(5).Value
Case Is = "金"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(6).Value
Case Is = "土"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(7).Value
Case Is = "日"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(8).Value
Case Else
End Select
If .Cells(i, j) = MyRNG.Cells(11) Then
If .Cells(i, j - 1) = "" Or .Cells(i, j - 1) = "出" Then
.Cells(i, j - 1).Value = MyRNG.Cells(10).Value
End If
If .Cells(i, j - 2) = "" Or .Cells(i, j - 2) = "出" Then
.Cells(i, j - 2).Value = MyRNG.Cells(9).Value
End If
If .Cells(i, j + 1) = "" Or .Cells(i, j + 1) = "出" Then
.Cells(i, j + 1).Value = MyRNG.Cells(12).Value
End If
If .Cells(i, j + 2) = "" Or .Cells(i, j + 2) = "出" Then
.Cells(i, j + 2).Value = MyRNG.Cells(13).Value
End If
End If
Next j
End If
Next i
End With
End Sub
上記のコードでうまくいってますので問題ないと思っております。
添削宜しくお願い致します。
（なのれい） 2019/09/22(日) 22:19
個人的には、Offset,Resize,MyRNG.Cellsの引数は、
もこな2さん同様、行列を省略せず、明示をお勧めします。
ちなみに、以下の結果は同じです。
MyRNG.Cells(2).Value MyRNG(1,2).Value
分かってもらえるかなぁ・・・
（tkit） 2019/09/23(月) 16:17
私がずっと言ってるのはFindメソッドの引数です。
Sub 実験用5()
Dim 発見セル As Range
With Workbooks.Add.Worksheets(1)
.Range("A1:A3") = WorksheetFunction.Transpose(Array("鈴木", "佐藤", "田中"))
With .Range("B1")
.Formula = "=A1"
.AutoFill Destination:=.Range("A1").Resize(3)
End With
Stop
Set 発見セル = .Range("A:A").Find(What:="佐藤", LookIn:=xlFormulas, LookAt:=xlWhole)
If Not 発見セル Is Nothing Then
MsgBox 発見セル.Address(0, 0) & "で発見しました"
Else
MsgBox "発見できませんでした"
End If
Set 発見セル = .Range("B:B").Find(What:="佐藤", LookAt:=xlWhole)
If Not 発見セル Is Nothing Then
MsgBox 発見セル.Address(0, 0) & "で発見しました"
Else
'▼LookInを省略して「xlFormulas」が承継されているから、見つからないことになる
MsgBox "発見できませんでした"
End If
Set 発見セル = .Range("B:B").Find(What:="佐藤", LookIn:=xlValues, LookAt:=xlWhole)
If Not 発見セル Is Nothing Then
'▼LookInで「xlValues」を指定すれば見つかる
MsgBox 発見セル.Address(0, 0) & "で発見しました"
Else
MsgBox "発見できませんでした"
End If
End With
End Sub
ちなみに、（今回は問題おきなさそうな気がしてきましたが・・）と言ったのは、↑のA列で「 LookIn:=xlFormulas」なのに発見できるように、直接入力しているならValueとFormulaが同じものになっていて問題なく見つかるかもと思ったからです。
（もこな２ ） 2019/09/24(火) 18:26
B1:B3順に＝A1,=A2,=A3と入力されており、最初のB列検索では、
検索対象が「 LookIn:=xlFormulas」数式で、What:="佐藤"を、
結果セルに入力されているそのものから、"佐藤"を探すので発見できず、
2回目の検索では、検索対象が「 LookIn:=xlValues」値で、
セルに入力されているものが数式であれば、その結果を検索対象としているので、
＝A2が入力されているセルB2が検出される、と。
で、検索対象の中身が変わるので、引数を指定してねってことですね。
（tkit） 2019/09/25(水) 08:50
【固定シフト】シート
1 2 3 4 5 6 7 8 9 10 11 12 13 14 ←列番号
____A____B_____C___D___E___F___G___H___I______J______K______L_____M______N____←列文字
1 指名 入替 +++++++++曜日休み+++++++++ +++++++++++サイクル+++++++++++
2 ++++ ++++ 月 火 水 木 金 土 日 前々 前 ベース 後 後々
3 相田 出 A 公 B 出
4 石田
5 植木 出 出 出 A 公 B 出
6 江本 公 公
7 織田 出 A 公 B 出
8 金本 C C C C C 公
9 木本 C C 公 C C C
10 工藤 C C C 公 C C
【作成シート】シート
1 2 3 4 5 6 7 8 9 10 11 12 31 ← H列からみて何列目か
_C_____D___E_______H___I___J___K___L___M___N___O___P___Q___R___S___..__AL__
5 2019 10 月 1 2 3 4 5 6 7 8 9 10 11 12 31 ← H列〜シリアル値
6 名前 火 水 木 金 土 日 月 火 水 木 金 土 木
7 相田 ●
8 佐藤
9 植木
10 織田
11 工藤
1,2日あるいは30,31日はどうするんでしょうか？
前後2日間見ようとすると、10月の表からはみ出しそうですが
（もこな２ ） 2019/09/25(水) 09:06
＞検索対象が「 LookIn:=xlFormulas」数式で、What:="佐藤"を、
＞結果セルに入力されているそのものから〜
そういうこと..ですかね？
私が実験用5で示したかったのは
A列
Value Formula Comment.Text
1 鈴木 鈴木 (コメント自体が存在しない)
2 佐藤 佐藤 (コメント自体が存在しない)
3 田中 田中 (コメント自体が存在しない)
B列
Value Formula Comment.Text
1 鈴木 =A1 (コメント自体が存在しない)
2 佐藤 =A2 (コメント自体が存在しない)
3 田中 =A3 (コメント自体が存在しない)
↑のようになっているのですから、B列を対象にした場合、LookIn(検索対象)が
値：xlValues →見つかる 数式：xlFormulas →見つからない コメント：xlComments →見つからない
となるので【LookInを省略すべきでない】ということだけです。
（もこな２） 2019/09/26(木) 13:43
Sub さんぷる()
Dim 月末日 As Long, 最終行 As Long, i As Long, c As Long
Dim 配列(13) As Variant
Dim 発見セル As Range, MyRNG As Range
Dim MyArr As Variant, buf As Variant
With Worksheets("作成シート")
'▼データがないときは強制終了
最終行 = .Cells(.Rows.Count, "C").End(xlUp).Row
If 最終行 < 7 Then
MsgBox "データなし"
Exit Sub
End If
'▼シリアル値から月末日を数値で算出
月末日 = Day(DateSerial(Year(Range("H5")), Month(Range("H5")) + 1, 0))
'▼7行目から最終行までループ処理
For i = 7 To 最終行
Set 発見セル = Worksheets("固定シフト").Range("A:A").Find(What:=.Cells(i, "C").Value, LookIn:=xlValues, LookAt:=xlWhole)
'▼----発見セルが見つかったときだけ処理----▼
If Not 発見セル Is Nothing Then
'配列に情報を格納
For c = 0 To 13
配列(c) = 発見セル.Offset(, c).Value
Next c
'▼1日〜月末までループ処理
For Each MyRNG In .Cells(i, "H").Resize(, 月末日)
'入替の処理？
If MyRNG.Value <> "" Then MyRNG.Value = 配列(1)
'曜日の処理
If MyRNG.Value <> "" Then
MyRNG.Value = 配列(1 + Weekday(.Cells(5, MyRNG.Column), vbMonday))
End If
'前後のチェック？
'月頭と月末それぞれ２日間は例外的な処理が必要？
Select Case Day(.Cells(5, MyRNG.Column))
Case 1 To 2
MyArr = Array(1, 2)
Case 3 To 月末日 - 3
MyArr = Array(-2, -1, 1, 2)
Case 月末日 - 2 To 月末日
MyArr = Array(-2, -1)
End Select
'前後のチェック？
For Each buf In MyArr
If MyRNG.Offset(, buf).Value = "" Or MyRNG.Offset(, buf).Value = "出" Then
MyRNG.Offset(, buf).Value = 配列(11 + buf)
End If
Next buf
Next MyRNG
End If
'▲----発見セルが見つかったときだけ処理----▲
Next i
End With
End Sub
（もこな２） 2019/09/26(木) 16:38
Find(What:=.Cells(i, "C").Value, LookIn:=xlValues, LookAt:=xlWhole)
ここの部分を省略しない方が良いって事ですよね。
理解出来ていないので、まず理解を深めていきます。
1,2日あるいは30,31日はどうするんでしょうか？
前後2日間見ようとすると、10月の表からはみ出しそうですが
これに関しましては最後にコメントクリアする予定でした。
（なのれい） 2019/09/27(金) 13:07
１．【(★6)Findメソッドについて】は読んでいただけましたか？ ２．実験用5 をステップ実行してみましたか？
＞これに関しましては最後にコメントクリアする予定でした。
わかりましたが、そうであれば不必要な処理はしないという選択肢もありますね。
そのうえで
・よく考えたら、配列に一旦取り込む必要はない
・提示のものだと２日に前日をチェックしない
・（月末が31だとして）30日に後日をチェックしない
というところがマズイとおもったので修正版です。（未テストなのでバグがあるかも）
Sub さんぷる修正()
Dim 月末日 As Long, 最終行 As Long, i As Long
Dim MyRNG As Range
Dim データ行 As Variant, Myarr As Variant, buf As Variant
Dim SH As Worksheet
Set SH = Worksheets("固定シフト")
With Worksheets("作成シート")
'▼データがないときは強制終了
最終行 = .Cells(.Rows.Count, "C").End(xlUp).Row
If 最終行 < 7 Then
MsgBox "データなし"
Exit Sub
End If
'▼シリアル値から月末日を数値で算出
月末日 = Day(DateSerial(Year(Range("H5")), Month(Range("H5")) + 1, 0))
'▼7行目から最終行までループ処理
For i = 7 To 最終行
データ行 = Application.Match(.Cells(i, "C").Value, SH.Range("A:A"), 0)
If Not IsError(データ行) Then
'▼----MATCH関数が成功したときだけ処理----▼
'▼1日〜月末までループ処理
For Each MyRNG In .Cells(i, "H").Resize(, 月末日)
'入替の処理？
If MyRNG.Value <> "" Then MyRNG.Value = SH.Cells(データ行, "B").Value
'曜日の処理
If MyRNG.Value <> "" Then
MyRNG.Value = SH.Cells(データ行, "B").Offset(, Weekday(.Cells(5, MyRNG.Column), vbMonday)).Value
End If
'前後のチェック？（準備）
Select Case Day(.Cells(5, MyRNG.Column))
Case Is = 1: Myarr = Array(1, 2) ' 後 後々
Case Is = 2: Myarr = Array(-1, 1, 2) ' 前 後 後々
Case 3 To 月末日 - 3: Myarr = Array(-2, -1, 1, 2) '前々 前 後 後々
Case Is = 月末日 - 2: Myarr = Array(-2, -1, 1) '前々 前 後
Case Is = 月末日: Myarr = Array(-2, -1) '前々 前
End Select
'前後のチェック？（本体）
For Each buf In Myarr
If MyRNG.Offset(, buf).Value = "" Or MyRNG.Offset(, buf).Value = "出" Then
MyRNG.Offset(, buf).Value = SH.Cells(データ行, "L").Offset(, buf).Value
End If
Next buf
Next MyRNG
End If
'▲-----MATCH関数が成功したときだけ処理----▲
Next i
End With
End Sub
（もこな２ ） 2019/09/27(金) 19:08
１．【(★6)Findメソッドについて】は読んでいただけましたか？
２．実験用5 をステップ実行してみましたか？
こちらどっちも確認しました。
ちょっとまだ自分で書いたコードを理解することでいっぱいいっぱいで何をお伝えしたいのか理解出来ないのが現状です。理解力が乏しくて申し訳ありません。
理解しようと頑張ってはいます。
また、提示頂いたコードもとても助かるのですが、初期のコードとかけ離れてしまい修正出来ない状態です。すべて自分の力不足がいけない事なんですけれども、出来ればまだ自分で修正出来る下記コードで行きたいと思っております。
Sub 固定シフト反映()
Dim i As Long, j As Long
Dim 名前 As String
Dim MyRNG As Range
With Worksheets("作成シート")
For i = 7 To .Range("C6").End(xlDown).Row
名前 = .Range("C" & i).Value
Set MyRNG = Worksheets("固定シフト").Range("A:A").Find(What:=名前, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not (MyRNG Is Nothing) Then
Set MyRNG = MyRNG.Offset(, 1).Resize(, 13)
For j = 7 To .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(6, j + 1) <> "" Then
If .Cells(i, j) = "" Then .Cells(i, j).Value = MyRNG.Cells(1).Value
End If
'▼「.Cells(5, j」の値で複数に条件分岐
Select Case .Cells(5, j).Value
Case Is = "月"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(2).Value
Case Is = "火"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(3).Value
Case Is = "水"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(4).Value
Case Is = "木"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(5).Value
Case Is = "金"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(6).Value
Case Is = "土"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(7).Value
Case Is = "日"
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(8).Value
Case Else
End Select
If .Cells(i, j) = MyRNG.Cells(11) Or .Cells(i, j) = "有給" Then
If .Cells(i, j - 1) = "" Or .Cells(i, j - 1) = "出" Then
.Cells(i, j - 1).Value = MyRNG.Cells(10).Value
End If
If .Cells(i, j - 2) = "" Or .Cells(i, j - 2) = "出" Then
.Cells(i, j - 2).Value = MyRNG.Cells(9).Value
End If
If .Cells(i, j + 1) = "" Or .Cells(i, j + 1) = "出" Then
.Cells(i, j + 1).Value = MyRNG.Cells(12).Value
End If
If .Cells(i, j + 2) = "" Or .Cells(i, j + 2) = "出" Then
.Cells(i, j + 2).Value = MyRNG.Cells(13).Value
End If
End If
Next j
End If
Next i
End With
End Sub
（なのれい） 2019/09/29(日) 09:31
ちなみに、渡辺ひかるさんのアイデアを拝借すれば、↓のような方法でも曜日を数字で取り出せるから
Sub 実験6()
Dim 曜日 As Long
曜日 = InStr("月火水木金土日", "月")
If 曜日 > 0 Then
MsgBox Mid("月火水木金土日", 曜日, 1) & "曜日"
End If
End Sub
曜日の部分は【InStr関数】を使って↓でもよいでしょうし
'▼「.Cells(5, j」の値で複数に条件分岐
曜日 = InStr("月火水木金土日", .Cells(5, j).Value)
If 曜日 > 0 Then
If .Cells(i, j).Value = "" Then .Cells(i, j).Value = MyRNG.Cells(1 + 曜日).Value
End If
前々、前、後、後々をみている部分は、【For Each 〜Nextステートメント】を使って↓のようにすれば、
If .Cells(i, j) = MyRNG.Cells(11) Or .Cells(i, j) = "有給" Then
For Each tmp In Array(-1, -2, 1, 2)
If .Cells(i, j + tmp) = "" Or .Cells(i, j + tmp) = "出" Then
.Cells(i, j + tmp).Value = MyRNG.Cells(11 + tmp).Value
End If
End If
End If
どちらも全パターンをいちいち書く必要はないと思います。
したがって、興味があれば【InStr関数】【For Each 〜Nextステートメント】について調べてみるとよいとおもいます。
（もこな２） 2019/09/29(日) 10:30
勉強してみます！！！
頑張りますので、これからも宜しくお願い致します！
（なのれい） 2019/09/29(日) 11:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.