従業員の詳細が記載されたExcelシートがあります。会社での年数に関する詳細を別のシートに表示する必要があります。
見せたい詳細は
- 今月の記念日
- 来月の記念日
- 今週の記念日
- 来週の記念日
- 今日の記念日
これらの詳細を、従業員名、記念日、入社年数とともに表示する必要があります。これらの各詳細は、ヘッダー付きの表に表示する必要があり、同じ列 (B、C、および D) にあります。
これはすべて以下のコードによって行われますが、並べ替え機能が機能していません。この場合、コレクションを使用するより効果的な方法があるかどうかを知る必要があります。
これが私が持っているコードです。
Sub PopulateAnniversaryData()
'Declaring Collections
Set TodayAnv = New Collection 'collection to store anniversaries today.
Set ThisWeekAnv = New Collection 'collection to store anniversaries this week.
Set NextWeekAnv = New Collection 'collection to store anniversaries next week.
Set CurrentMonthAnv = New Collection 'collection to store anniversaries of current month.
Set NextMonthAnv = New Collection 'collection to store anniversaries of next month.
'getting current details
CurrentDay = Day(Now()) 'getting current year.
CurrentMonth = Month(Now()) 'getting current month.
CurrentYear = Year(Now()) 'getting current year.
CurrentWeek = Application.WorksheetFunction.WeekNum(Now()) 'getting the current week number.
CurrentDate = Year(Now()) & "/" & Month(Now()) & "/" & Day(Now()) 'forming current date.
EmpDetailsLR = LastRowInColumn(1, ED.Name) 'finding the last row in employee details page.
Dim EmpADate As Date 'declaring a variable to hold employee anniversary date.
For EmpDetailsFR = 2 To EmpDetailsLR
JoiningMonth = Month(ED.Range(JoinDateColumnNa & EmpDetailsFR).Value) 'finding employee joining month.
JoiningDay = Day(ED.Range(JoinDateColumnNa & EmpDetailsFR).Value) 'finding employee joining day.
JoiningYear = Year(ED.Range(JoinDateColumnNa & EmpDetailsFR).Value) 'finding employee joining year.
YearsInEY = CurrentYear - JoiningYear 'finding number of years employee worked for EY.
EmpName = ED.Range("C" & EmpDetailsFR).Value 'finding Employee name.
EmpJDate = ED.Range(JoinDateColumnNa & EmpDetailsFR).Value 'finding Employee joining date.
EmpADate = Year(Now()) & "/" & Month(EmpJDate) & "/" & Day(EmpJDate) 'forming employee anniversary date.
JoiningWeek = Application.WorksheetFunction.WeekNum(EmpADate) 'finding employee joining week.
If Trim(LCase(ED.Range("H" & EmpDetailsFR).Value)) <> "resigned" And YearsInEY > 0 Then
'Finding employees with anniversary today.
If CurrentDate = EmpADate Then _
TodayAnv.Add Array(EmpName, "Today", YearsInEY)
'Finding employees with anniversary this week.
If CurrentWeek = JoiningWeek Then _
ThisWeekAnv.Add Array(EmpName, WeekDayName(EmpADate), YearsInEY)
'Finding employees with anniversary next week.
If CurrentWeek + 1 = JoiningWeek Then _
NextWeekAnv.Add Array(EmpName, EmpADate, YearsInEY)
'Finding employees with anniversary this month.
If CurrentMonth = JoiningMonth Then _
CurrentMonthAnv.Add Array(EmpName, EmpADate, YearsInEY)
'Finding employees with anniversary next month.
If CurrentMonth + 1 = JoiningMonth Then _
NextMonthAnv.Add Array(EmpName, EmpADate, YearsInEY)
End If
Next
'sorting current month anniversaries based on anniversary date.
For Collection_Counti = 1 To CurrentMonthAnv.Count - 1
For Collection_Countj = Collection_Counti + 1 To CurrentMonthAnv.Count
If CurrentMonthAnv(Collection_Counti)(1) > CurrentMonthAnv(Collection_Countj)(1) Then
'store the lesser item
vTemp = CurrentMonthAnv(Collection_Countj)
'remove the lesser item
CurrentMonthAnv.Remove Collection_Countj
're-add the lesser item before the greater Item
CurrentMonthAnv.Add vTemp(Collection_Counti)
End If
Next Collection_Countj
Next Collection_Counti
'sorting next month anniversaries based on anniversary date.
For Collection_Counti = 1 To NextMonthAnv.Count - 1
For Collection_Countj = Collection_Counti + 1 To NextMonthAnv.Count
If NextMonthAnv(Collection_Counti)(1) > NextMonthAnv(Collection_Countj)(1) Then
'store the lesser item
vTemp2 = NextMonthAnv(Collection_Countj)
'remove the lesser item
NextMonthAnv.Remove Collection_Countj
're-add the lesser item before the greater Item
NextMonthAnv.Add vTemp2(Collection_Counti)
End If
Next Collection_Countj
Next Collection_Counti
WriteInRow = 3
'populating anniversaries this month
If CurrentMonthAnv.Count <> 0 Then
AN.Range("B2").Value = "Anniversaries This Month"
AN.Range("C2").Value = "Date"
AN.Range("D2").Value = "Years In EY"
For AnvDic = 1 To CurrentMonthAnv.Count
AN.Range("B" & WriteInRow).Value = CurrentMonthAnv(AnvDic)(0)
AN.Range("C" & WriteInRow).Value = CurrentMonthAnv(AnvDic)(1)
AN.Range("D" & WriteInRow).Value = CurrentMonthAnv(AnvDic)(2)
WriteInRow = WriteInRow + 1
Next
WriteInRow = WriteInRow + 1
End If
'populating anniversaries next month
If NextMonthAnv.Count <> 0 Then
AN.Range("B" & WriteInRow).Value = "Anniversaries Next Month"
AN.Range("C" & WriteInRow).Value = "Date"
AN.Range("D" & WriteInRow).Value = "Years In EY"
WriteInRow = WriteInRow + 1
For AnvDic = 1 To NextMonthAnv.Count
AN.Range("B" & WriteInRow).Value = NextMonthAnv(AnvDic)(0)
AN.Range("C" & WriteInRow).Value = NextMonthAnv(AnvDic)(1)
AN.Range("D" & WriteInRow).Value = NextMonthAnv(AnvDic)(2)
WriteInRow = WriteInRow + 1
Next
End If
'similarly I will populate anniv this week, next week, today etc
ActiveSheet.Columns.AutoFit
End Sub
ここに私が知りたいことがあります。
コレクションを使用する以外にこれを行うより良い方法はありますか? もしそうなら、どのようにそれを行うことができますか？(私は、vba 機能以外のものは使用しないことを好みます)
コレクションに実装した並べ替え機能が正しく機能せず、エラーが発生します。並べ替えを正しく使用する方法を提案してください。コードを提供します。私はコレクションが初めてです。
ノート：
このコードでは、いくつかのカスタム関数が使用されています。デフォルトでは Excel で利用できないものがあっても気にしないでください。
私の従業員詳細シートはアルファベット順にソートされています。記念日に基づいて並べ替えを実装したい。