我有一张包含员工详细信息的 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 中不可用的内容，请不要打扰。
我的员工详细信息表按字母顺序排序。我想根据周年日期实现排序。