我有一份包含员工详情的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中没有的内容，请不要打扰。
我的员工详细信息表按字母顺序排序。我想根据周年纪念日实施排序。
答案 0 :(得分：1)
为了使您的代码更加清晰和易于管理，其中一种方法是在VBA Excel中考虑面向对象的方式并创建类模块。
示例：
课程模块名称：周年纪念日
内容：
Public EmployeeName as string
Public EmployeeDate as Date
Public YearsInEY as string
在您的模块代码中，为类创建新对象并分配值
Dim oTodayAnniversary as new Anniversary
oTodayAnniversary.EmployeeName = value
oTodayAnniversary.EmployeeDate = value
oTodayAnniversary.YearsInEY = value
使用上述集合在新表上打印。
您甚至可以通过向Anniversary Class模块添加枚举标记来创建单个集合，以填充所有数据，这将标识类别类型。