Q&A
希望に相か分かりませんがサンプルコードも
記載しました
PCの画面、左半分シート・右半分Moduleに表示して
一度Module画面の方をクリックしてからキーボードの
［F8］キーを押すとプログラムがどのような動き
するか判ります
コード長いですが、よろしく
エクセルのVBAを勉強中なのですがコードが分からないのでアドバイスをお願いします。
やりたいことは確認シートのE２とG2に入力された日付の範囲内で出勤した日数がE3とG3で入力された日数出勤してる人だけを抽出してそのシート名を確認シートのA2からA3・A4・・・と返したいです。以下書いてみたコードです。これだと1週目と２週目に3日出勤した人は２回名前が載ることになってしまいます。２週目だけや３週目だけ○日出勤した人を抽出するにはどうしたらいいでしょうか。よろしくお願いします。
※1週間ごとに出勤した日数は計算されます。例えば、Aさんのシートの10/110/7まで欄にシフトを入力するとAさんのシートのJ9:J13の結合されたセルに勤務日数が返ります。10/14まで）のシフトを入力するとJ16:J20の結合セルに出勤日数が返ります
※第２週（10/8
※Aさん以下B・C・D・・・と同じシートです。
※入力は〇週ではなく日付で行いたいです。
vba
1Sub 出勤日数() 2 3Dim i As Long 4Dim keyword As String 5Dim lastrow As Long 6 7keyword = Worksheets("確認").Cells(3, 5).Value 8For i = 1 To Worksheets.Count 9If Worksheets(i).Name <> "確認" Then 10For 日付行1 = 9 To 36 11If Worksheets(i).Cells(日付行1, 10).Value = keyword Then 12Worksheets("確認").Activate 13lastrow = Worksheets("確認").Cells(Rows.Count, 1).End(xlUp).row 14Worksheets("確認").Cells(lastrow + 1, 1).Value = Worksheets(i).Name 15End If 16Next 日付行1 17End If 18Next i 19 20End Sub
回答4件
0
投稿2020/10/22 09:03
総合スコア312
0
Option Explicit
Dim 自期 As Date
Dim 去期 As Date
Dim 日数 As Long
Dim i As Long 'シートカウント
Dim s As Long '判断日数Range("E3")
Dim 行数 As Long
Dim 行変数 As Long
Dim Rhajime As Long '初めのRow番地
Dim Rowari As Long '終わりのRow番地
Sub データ取得()
'****//指示された１週間のデータ集計します//*****************
Application.ScreenUpdating = False
Sheets("確認").Select
自期 = Cells(2, 5).Value '週の始まり
去期 = Cells(2, 7).Value '週の終わり
For i = 2 To Sheets.Count '社員名シート左から２番めから
Sheets(i).Select '左から（i)番目
行数 = Cells(Rows.Count, 2).End(xlUp).Row 'シート（i)番目の日付最終行
For 行変数 = 9 To 行数
Cells(行変数, 2).Select
If Cells(行変数, 2) = 自期 Then '日付行と自期照合(週初め)
Rhajime = 行変数 '行変数(Row番地)を変数Rhajimeに保管
Else
If Cells(行変数, 2) = 去期 Then '去期(週終わり)
Rowari = 行変数 - 1 '行変数(Row番地)を変数 Rowariに保管
'Excel関数（CountIf)使う為１週間のセル範囲する Range(Cells(Rhajime, 4), Cells(Rowari, 4)).Select 日数 = WorksheetFunction.CountIf(Range(Cells(Rhajime, 4), _ Cells(Rowari, 4)), "〇") Cells(Rhajime, 10) = 日数 Exit For End If End If Next 行変数
Next i
Call データ表示 '//一か月の日数表示//
Call データ表示1 '*****//1週間の日数表示//***
Sheets("確認").Select
Application.ScreenUpdating = True
End Sub
Sub データ表示()
Dim ii As Long '
Dim n As Long '行間隔(週７日）
Sheets("確認").Select
For ii = 1 To 4 '4週間
For i = 2 To Sheets.Count
Sheets(i).Select
日数 = Cells(9 + n, 10).Value
Sheets("確認").Cells(9 + i, 2 + ii) = 日数
Sheets("確認").Cells(9 + i, 2) = Sheets(i).Name
Next i
n = n + 7 '行間隔(週７日）
Next ii
Sheets("確認").Select
End Sub
Sub データ表示1()
Dim ii As Long '
Dim n As Long '行間隔
'明細クリア******************
Sheets("確認").Select
Range("C11:F28").Select
Selection.ClearContents
Range("B11").Select
'***************************************
自期 = Cells(2, 5).Value
For i = 2 To Sheets.Count
Sheets(i).Select 行数 = Cells(Rows.Count, 2).End(xlUp).Row For 行変数 = 9 To 行数 Cells(行変数, 2).Select If Cells(行変数, 2) = 自期 Then Rhajime = 行変数 '***//ここで何週目のデータか判断//****** If Rhajime = 9 Then Call 第1週目 If Rhajime = 16 Then Call 第2週目 If Rhajime = 23 Then Call 第3週目 If Rhajime = 30 Then Call 第4週目 End If Next 行変数 Next i
End Sub
Sub 第1週目()
'//Sheets("確認")へ出力//← Sheets(i)の勤務日数***
Sheets("確認").Cells(9 + i, 3) = Cells(Rhajime, 10).Value
End Sub
Sub 第2週目()
Sheets("確認").Cells(9 + i, 4) = Cells(Rhajime, 10).Value
End Sub
Sub 第3週目()
Sheets("確認").Cells(9 + i, 5) = Cells(Rhajime, 10).Value
End Sub
Sub 第4週目()
Sheets("確認").Cells(9 + i, 6) = Cells(Rhajime, 10).Value
End Sub
投稿2020/10/22 08:40
総合スコア312
0
Sub 出勤日数()
Dim i As Long
Dim keyword As String
Dim lastrow As Long
Dim Week As Long '1週間（７日）
Dim 日数 As Long
'**//月始めのデータのみ取得//*************************************
keyword = Worksheets("確認").Cells(3, 5).Value
For i = 2 To Worksheets.Count
If Worksheets(i).Name <> "確認" Then
For 日付行1 = 1 To 4 '４週間 If Worksheets(i).Cells(9 + Week, 10).Value >= keyword Then 日数 = Worksheets(i).Cells(9 + Week, 10).Value MsgBox Worksheets(i).Name & Chr(10) & 日数 Week = Week + 7
' Worksheets("確認").Activate
lastrow = Worksheets("確認").Cells(Rows.Count, 1).End(xlUp).Row '**//シート名を表示と勤務日数//******************** Worksheets("確認").Cells(lastrow + 1, 1).Value = Worksheets(i).Name Worksheets("確認").Cells(lastrow + 1, 2).Value = 日数 Exit For '見つかった週から抜ける（次のシートへ） End If Next 日付行1 End If Week = 0 '次のシートの１週目に入る為
Next i
End Sub
投稿2020/10/22 08:32
総合スコア312
0
いくつか不明点があります。
１．日付は全シート同じなのでしょうか。
例えば、Ａさんは9月28日～10月25日ですが、Ｂさんは9月30日～10月27日になっていることは、
あり得るのでしょうか。
２．同じ条件に一致する人が複数の場合、
確認シートのどのセルに、そのシート名を返すのでしょうか。
３．各員のシートは1週間毎に、出勤日数がまとめられており、それを参照するということですが、
例えば、9月28日～9月30日が指定された場合、10月1日から10月4日までの、出勤日数も含まれて
しまいます。
従って、開始日から終了日を指定するのではなく、第○週から第●週までを指定させてはいかがでしょうか。
（○●は１～４）
それとも、日付の指定時、9月28日～9月30日はエラーにして、9月28日～10月4日のみが正常扱いにしたいのでしょうか。
投稿2020/10/19 20:42
総合スコア5438
syun0334様のソースコード実行してみましたが
無限ループが発生しました。
Book名を見ると（version)自動回復されたソースコードのようで修正前？
そこで、syun033様のコード基に勝手に変えてみましたが
月始めの１週間のデータしか読みとれませんでした
コード載せておきます
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。