アプリ版:「スタンプのみでお礼する」機能のリリースについて

エクセルのVBAを勉強中なのですがコードが分からないのでアドバイスをお願いします。
やりたいことは確認シートのE2とG2に入力された日付の範囲内で出勤した日数がE3とG3で入力された日数出勤してる人だけを抽出してそのシート名を確認シートのA2からA3・A4・・・と返したいです。以下書いてみたコードです。これだと1週目と2週目に3日出勤した人は2回名前が載ることになってしまいます。2週目だけや3週目だけ○日出勤した人を抽出するにはどうしたらいいでしょうか。よろしくお願いします。
※1週間ごとに出勤した日数は計算されます。例えば、Aさんのシートの10/1~10/7まで欄にシフトを入力するとAさんのシートのJ9:J13の結合されたセルに勤務日数が返ります。
※第2週(10/8~10/14まで)のシフトを入力するとJ16:J20の結合セルに出勤日数が返ります
※Aさん以下B・C・D・・・と同じシートです。

【コード】
Sub 出勤日数()

Dim i As Long
Dim keyword As String
Dim lastrow As Long

keyword = Worksheets("確認").Cells(3, 5).Value
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "確認" Then
For 日付行1 = 9 To 36
If Worksheets(i).Cells(日付行1, 10).Value = keyword Then
Worksheets("確認").Activate
lastrow = Worksheets("確認").Cells(Rows.Count, 1).End(xlUp).row
Worksheets("確認").Cells(lastrow + 1, 1).Value = Worksheets(i).Name
End If
Next 日付行1
End If
Next i

End Sub

「指定した日付の範囲内でデータを転記したい」の質問画像

質問者からの補足コメント

  • 早速のお返事ありがとうございます。試してみたのですが、E2とG2の日付の範囲内でデータが検索されていないように思えたのですがどうすればいいでしょうか。

    No.2の回答に寄せられた補足コメントです。 補足日時:2020/10/29 19:38
  • 早速のお返事ありがとうございます。実際にやってみたのですが【 終行 = s + (Int((終日 - 初日 + 1) / n)) * n】の部分にエラーが出てしまいます。
    また補足になりますがすべての人が同じサイクルで日付は書いてあります。例えばB9にはすべての人が9月28日の日付が入っていて以下B36まで連続した日付が並んでいてB36は10月25日になります。翌月にはB9は全員10月26日になりB36は11月22日になります。VBAを勉強中の初心者故に質問ばかりになりますがよろしくお願いします。

    No.3の回答に寄せられた補足コメントです。 補足日時:2020/10/29 22:44

A 回答 (3件)

ここは 受託コーディングではないということになっているのだそうです。


変数をアルファベットで書くのが普通ですが、漢字なども使えます。
Set で、シートやRANGEなどの、オブジェクトを指定すると、便利なことも多いです。
一致を個々にチェックする以外に、目的によっては、CountIfを利用する方法もあります。
例えば、月曜から日曜の7日間ごとの勤務日数を対象として、その日数が行を結合したセルに表示されている場合には、《確認シートのE2とG2に入力された日付の範囲内》という指定の解釈が、かなり難しいです。(E2が水曜日で、G2が翌週の木曜日)の場合、その9日間には、(月曜から日曜の7日間)は1つもないです。 《確認シートのE2とG2に入力された日付の範囲内》でチェックするのはどこなのかを決めるルールを作る必要があります。Sampleは、その一例です。
また、各人のシートの様式(記入欄やセル結合の仕方)が同じでも、人によって、9行目から始まる日付が、ある人は8月1日から、別の人は4月1日からというように違っていた場合もあると思います。 そうしたことも一応考えないといけないように思います。

Sub sample()
Dim 始期日, 終期日, 初日, 終日, 指定1, 指定2, 名前, 確認S
Dim 始行, 終行, 範囲, 当否
Dim s, n         ' これら Dim の宣言はなくても可

Set 確認S = Worksheets("確認")

s = 9: n = 7 'sは各人の日付の始まる行No. nは1週の日数(=結合セルの行数)
確認S.Activate

始期日 = Cells(2, 5): 終期日 = Cells(2, 7)
指定1 = "=" & Cells(3, 5): 指定2 = "=" & Cells(3, 7)
確認S.Columns("A:A").Clear
確認S.Cells(1, 1) = "シート名"

For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "確認" Then
With Worksheets(i)
初日 = .Cells(s, 2): 始行 = s
If (初日 < 始期日) Then 始行 = s + Int((始期日 - 初日 + 1) / n + 1) * n
終日 = .Cells(s, 2).End(xlDown)
終行 = s + (Int((終日 - 初日 + 1) / n)) * n
If (終期日 < 終日) Then 終行 = s + Int((終期日 - 初日 + 1) / n - 1) * n
Set 範囲 = Range(.Cells(始行, 10), .Cells(終行, 10))
当否 = WorksheetFunction.CountIf(範囲, 指定1) + _
WorksheetFunction.CountIf(範囲, 指定2) > 0
If 当否 Then 確認S.Cells(500, 1).End(xlUp).Offset(1) = .Name
End With
End If
Next

End Sub
「指定した日付の範囲内でデータを転記したい」の回答画像3
この回答への補足あり
    • good
    • 0

というかそもそも結合しているんだから「9~36」全部を見る必要ない


ですよね。

Const shtName As String = "確認"
Dim i As Long
Dim keyword As String
Dim lastrow As Long
Dim wkNum As Integer

With Worksheets(shtName)
keyword = .Range("E3").Value
.Range("A:A").ClearContents
.Range("A1").Value = "シート名"
lastrow = 2 'というか開始行
wkNum = 2 '第二週を対象にする
End With

For i = 1 To Worksheets.Count
If Worksheets(i).Name <> shtName Then
If Worksheets(i).Cells(wkNum * 7 + 2, 10).Value = keyword Then
Worksheets(shtName).Cells(lastrow, 1).Value = Worksheets(i).Name
lastrow = lastrow + 1
End If
End If
Next i
この回答への補足あり
    • good
    • 0

「For 日付行1 = 9 To 36」のところを変数にして指定行によって変動


するようにしたらどうですか?
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!