Option Explicit' 从选择单元格中 随机选取n个不同单元格
Private Function sampling(ByVal n As Long)' 选中单元格总数Dim totalCellsCnt As Long' 目标区域 为选择区域与使用区域的交集  防止误选整个工作表造成程序假死Dim targetRng As Range' 合并所有随机选取的单元格 再填色Dim tmpRng As RangeDim iSet targetRng = Intersect(Selection, ActiveSheet.UsedRange)totalCellsCnt = targetRng.Cells.Count' 如果总数小于等于需要选取目标单元格数If totalCellsCnt <= n Thenfill targetRng, 6Else' 生成 不重复 的随机数  将索引对应的所有单元通过Union选取For Each i In generateNRndNr(1, totalCellsCnt, n)If tmpRng Is Nothing ThenSet tmpRng = targetRng.Cells(i)ElseSet tmpRng = Union(tmpRng, targetRng.Cells(i))End IfNext i' 填色fill tmpRng, 6End IfEnd Function' 将目标范围填色
Private Function fill(ByRef rng As Range, ByRef colorIdx As Long)Selection.Interior.ColorIndex = -4142rng.Interior.ColorIndex = colorIdxEnd Function' 生成n个不重复的随机数， 范围 大于 start 小于 ende
Private Function generateNRndNr(ByRef start As Long, ByRef ende As Long, ByRef n As Long) As VariantIf n < ende - start + 1 ThenReDim res(0 To n - 1)Dim iDim cnt As Long' 数据结构 之 字典， 字典的索引的惟一性 保证返回5个惟一值Dim d As ObjectSet d = CreateObject("scripting.dictionary")' 字典索引数目小于 所要求数目时 进行取值 并存入 索引(键)' 由于值不重要 统一设为1Do While d.Count < nd(start + Int(Rnd * (ende - start))) = 1LoopEnd IfgenerateNRndNr = d.KeysEnd FunctionSub main()sampling 5
End Sub

Function DateSerial(Year As Integer, Month As Integer, Day As Integer)

DateSerial(2018, 2, 0)

Function Weekday(Date, [FirstDayOfWeek As VbDayOfWeek = vbSunday])

? weekday(date,vbMonday)

Private Function payDay(ByVal y As Integer, ByVal m As Integer) As Date

Private Function payDay(ByVal y As Integer, ByVal m As Integer) As Date' 最后一天Dim d As Date' 星期数Dim wd As Integerd = DateSerial(y, m + 1, 0)wd = Weekday(d, vbMonday)' 星期数与对应天数关系' 1-> -3  2-> -4  3-> -5  4 -> -6  5 -> 0  6 -> -1  7-> -2payDay = DateAdd("d", IIf(wd >= 5, 5 - wd, -2 - wd), d)End Function

payDay = DateAdd("d", IIf(wd >= 5, 5 - wd, -2 - wd), d)

payDay = DateSerial(y, m + 1, IIf(wd >= 5, 5 - wd, -2 - wd))