1、实现原理：

艾宾浩斯seid一个知识点学习后要复习8次后可达到永久记忆(这个还有待验证。。。)，其复习间隔时间分别为1d、2d、4d、7d、15d、30d、90d、180d。

2、实现效果：

在一个sheet【学习清单】里按日期记录每天的学习内容(如图1)，在另外一个sheet【当日复习清单】里提供日期选择功能，并根据选择日期切换显示当日需要复习的内容(如图2)。

图1：

图2：

3、用到的知识点：

3.1 二分查找算法：

随着记录的学习内容渐渐多，需要节省查找时间。使用这个算法的前提是每天的学习内容是按日期升序排序的。

3.2 vba返回单元格的3种方式：

sheet1.range("b2:d4")；sheet1.cells(3,4)；sheet1.[a2:d6]。因为涉及不同sheet表之间的取值，所以需要标明sheet页名称。

3.3 返回一列单元格有数据的最后一行：

Worksheets("学习清单").Range("a1048576").End(3).Row

Range("a1048576").End(3) 代表从 a1048576单元格往前查找到的第一个有数据的单元格。

Range("a1048576").End(3).Row 表示A列单元格最下面一个有数据的单元格的行号。

End(3)这个3代表常量 xlup，表示向上搜索。

2003版本后一张Excel工作表，最多可以包括1048576行和16384列。

3.4 vba中实现数值改变单元格后触发事件：

假设要判断的值在A1，则代码为：

Dim oldval

Private Sub Worksheet_Activate()

oldval = [a1]

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If oldval <> [a1] Then

oldval = [a1]

'在此输入操作代码

End If

End Sub

4、全部vba代码如下：

1 Dim date_select '选择的复习日期

2 Dim array_a(8) '存储复习间隔，共8个间隔

3

4 Private SubWorksheet_Activate()5 date_select = Worksheets("当日复习清单").[b1]6 array_a(8) = 1

7 array_a(7) = 2

8 array_a(6) = 4

9 array_a(5) = 7

10 array_a(4) = 15

11 array_a(3) = 30

12 array_a(2) = 90

13 array_a(1) = 180

14 End Sub

15 Private Sub Worksheet_Change(ByVal Target AsRange)16 If date_select <> Worksheets("当日复习清单").[b1] Then

17 date_select = Worksheets("当日复习清单").[b1]18 Worksheets("当日复习清单").[a4:d1048576] = ""

19

20 Dim array_b(8) '存储所选择的复习日期对应的学习日期，共8个

21 Dim hang_all, hang_half '学习日期的有数据的最后行号和中间行号

22 Dim find_begin, find_end '查找学习日期时的开始行号和结束行号

23

24 Dim hang_now '存储复习内容的长度，每次选择日期后会更新为0

25 hang_now = 0

26

27 hang_all = Worksheets("学习清单").Range("a1048576").End(3).Row '返回一列单元格有数据的最后一行

28 hang_half = Int(hang_all / 2)29

30 For i = 1 To 8 '计算学习日期

31 array_b(i) = date_select -array_a(i)32

33 If Worksheets("学习清单").Cells(hang_half, 1) <= array_b(i) Then '利用二分查找算法提高查找效率

34 Do While Worksheets("学习清单").Cells(hang_half, 1) = Worksheets("学习清单").Cells(hang_half - 1, 1)35 hang_half = hang_half - 1

36 Loop '解决：中间行号的学习日期和前后日期相等的情况

37 find_begin =hang_half38 find_end =hang_all39 Else

40 Do While Worksheets("学习清单").Cells(hang_half, 1) = Worksheets("学习清单").Cells(hang_half + 1, 1)41 hang_half = hang_half + 1

42 Loop '解决：中间行号的学习日期和前后日期相等的情况

43 find_begin = 2

44 find_end =hang_half45 End If

46

47 For j = find_begin To find_end '根据学习日期返回复习内容

48 If Worksheets("学习清单").Cells(j, 1) = array_b(i) Then

49 hang_now = hang_now + 1

50 Worksheets("当日复习清单").Cells(hang_now + 3, 1) =hang_now51 Worksheets("当日复习清单").Cells(hang_now + 3, 2) = Worksheets("学习清单").Cells(j, 2) '复习内容

52 Worksheets("当日复习清单").Cells(hang_now + 3, 3) = Worksheets("学习清单").Cells(j, 3) '时长

53 Worksheets("当日复习清单").Cells(hang_now + 3, 4) = Worksheets("学习清单").Cells(j, 1) '学习日期

54 End If

55 Nextj56 find_find = j '因为要找的学习日期是升序存储的，所以查找下一个学习日期时可以把查找的开始行号改为j

57 Nexti58 Dimtime_sum59 time_sum = Application.WorksheetFunction.Sum(Worksheets("当日复习清单").Range("c:c"))60 Worksheets("当日复习清单").[a2] = "共需复习" & hang_now & "个内容，共需" & time_sum & "分钟"

61 End If

62 End Sub