代码优化 – Excel VBA收集和收集sorting

我有一个excel工作表的细节员工。 我需要在公司的另一张表格上显示一些细节。

我想展示的细节是

1. 本周纪念日
2. 下个月的周年纪念日
3. 本周纪念日
4. 周年纪念日
5. 今天的周年纪念日

我需要显示员工姓名，周年date和年份在公司的这些细节。 这些细节中的每一个都应该显示在一个带有标题的表格中，并且它们在相同的列（B，C和D）中。

所有这一切都是由下面的代码完成的，但sortingfunction不起作用，我需要知道在这种情况下是否有更有效的方法来使用收集。

这是我的代码。

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 

这是我想知道的事情。

1. 除了使用集合，还有更好的方法吗？ 如果是这样怎么办？ （我更喜欢不使用vb​​afunction以外的任何东西）

2. 我在集合中实现的sortingfunction不能正常工作，并导致错误。 请build议一种正确使用sorting的方法。 提供一个代码。 我是新的collections。

笔记：

1. 这段代码使用了一些自定义函数。 不要打扰，如果你看到一些在Excel中默认不可用的东西。

2. 我的员工详情表按字母顺序排列。 我想实施基于周年date的sorting。

Answer 1

为了使你的代码干净和易于pipe理，其中一种方法就是思考面向对象的方式，并在你的VBA Excel中创build类模块 。

例：

Class Module Name：Anniversary

内容：

 Public EmployeeName as string Public EmployeeDate as Date Public YearsInEY as string 

在您的模块代码中，为类创build新对象并分配值

 Dim oTodayAnniversary as new Anniversary oTodayAnniversary.EmployeeName = value oTodayAnniversary.EmployeeDate = value oTodayAnniversary.YearsInEY = value 

使用上述集合在新纸上打印。

您甚至可以创build单个集合来填充所有数据，方法是向Anniversary Class模块添加一个Enum标志，该模块将标识Categorytypes。