写在前面

我很多年前看过晨间日志的奇迹这一本书，我深受启发，这本书的中心思想就是通过九宫格的方式写连体日志，自己可以方便查找而有而且有激情去完成这个日志，书中推荐的方法是使用excel写日志。但是自己总感觉用excel过于麻烦，打开电脑，写日志，可能10几分钟过去了。自己曾尝试使用其他方法，如印象笔记，有道云笔记，onenote，但是都没有坚持下来，主要原因还是写日志的过程过于复杂，没有办法宏观的看自己取得了哪些成果和进步，而且时间往往都比较紧张，没有办法在早晨完成日志。导致最后变成了月计划周计划。自己也一直想打造一款个人的日志软件，想使用django+vue，但是一直没有想好数据如何存储，如果存在数据库，搭建在云服务器上，可能还需要花费额外的金钱，而且便宜的云数据库往往速度不是很快。直到最近遇到了vba这个语言，突然深受启发，开始使用vba打造一款excel的日志软件。

使用excel打造个人日志系统的整体逻辑

整体上使用excel打造个人日志系统，就类似于通过一个表单提交数据到数据库当中，在这里一个sheet页里存的是一个表单，另外一个sheet页存储excel提交的信息，相当于数据库。
在Excel当中可以添加VB宏，相当于后端逻辑。可以通过插入一些形状作，为一些前端的控件，然后把控件和宏进行关联，点击控件执行宏的逻辑。
接下来将一步一步教你如何打造这款日志系统。

写日记页面介绍

在这里插入图片描述
在写日记页面主要有两个表单，第一个表单是默认是当天的日期，然后可以在九宫格中填入当天需要记下的日志，点击提交按钮，将会将数据存储到excel中的晨间日记数据库中。第二个表单主要目的是可以查看过去编写的日志，感受到自己的变化，默认信息是去年同一天记录的日志。在这个表单中也可以切换日期，通过切换年、切换日、或者点击今天切换日期，也可以在日期单元格指定具体的日期，点击查询，将会切换到具体的日期。点击重新编辑将会将第二个表单的中的信息覆盖到第一个表单中，允许你重新编辑该天信息。编辑后点击提交按钮，将会把指定日期的信息重新覆盖。

使用宏开发组件

在WPS中选择开发工具，然后选择VB宏就可以添加个人的宏代码，点击对应的sheet页，在该页面添加需要实现的宏。
在这里插入图片描述

第一个重要的宏就是实现将写日记页面中的数据提交到晨间日记数据库页面中存储的功能，如下两图
在这里插入图片描述

提交宏

宏代码如下

Sub 提交_Click()
    Dim x As Integer, y As Long, z As Integer
    y = Sheets("晨间日记数据库").[a65536].End(xlUp).Row + 1
    brr = Sheets("晨间日记数据库").Range("a2:a" & y)
    t = Sheets("写日记").Range("l16")
    arr = Array(Sheets("写日记").Range("l16"), Sheets("写日记").Range("L18"), Sheets("写日记").Range("L19"), Sheets("写日记").Range("L20"), Sheets("写日记").Range("L21"), Sheets("写日记").Range("L22"), Sheets("写日记").Range("L23"), Sheets("写日记").Range("B5"), Sheets("写日记").Range("i5"), Sheets("写日记").Range("p5"), Sheets("写日记").Range("B15"), Sheets("写日记").Range("p15"), Sheets("写日记").Range("B25"), Sheets("写日记").Range("i25"), Sheets("写日记").Range("p25"))
    If IsEmpty(brr) Then
     Sheets("晨间日记数据库").Range("a" & y).Resize(1, UBound(arr) + 1) = arr
    Else
    For x = 1 To UBound(brr)
        If t = brr(x, 1) Then
            i = MsgBox("相同日期的数据已录入，是否覆盖？", 4, "警告")
            If i = vbNo Then Exit Sub
            Sheets("晨间日记数据库").Range("a" & x + 1).Resize(1, UBound(arr) + 1) = arr
            GoTo line1:
        End If
    Next
    Sheets("晨间日记数据库").Range("a" & y).Resize(1, UBound(arr) + 1) = arr
    End If
line1:
    MsgBox "提交成功"
    Range("AH16") = Range("l16")
    Range("B5:V13,B15:H23,P15:V23,B25:H33,I25:O33,P25:V33,l18:O23").ClearContents
    ActiveWorkbook.Save
End Sub

代码的具体含义如下：

定义变量：x，y，z，和数组变量brr和arr。
计算晨间日记数据库页面目前已有的数据行数，然后将新数据添加到下一行（即初始化变量y）。
将晨间日记数据库页面中所有的日期数据（即a2到a[y]）存储在数组变量brr中，并将写日记页面中的所有需要提交的数据存储在数组变量arr中。
如果数组brr为空，则说明数据表中还没有任何数据，直接将arr数组存储到a[y]到a[y]+UBound(arr)+1行中。
如果数组brr非空，则表示数据表中已经有数据，需要对它们逐一进行比对，判断新添加的数据是否重复。如果存在相同记录则提醒用户进行覆盖或直接退出，然后将新的数据覆盖原来的数据。
提交数据成功后，清空写日记页面中的数据，并将日期数据存储在AH16单元格中。最后，提示用户提交成功，并保存当前工作表。

至此已经完成了一个重要的功能，存储日志数据到晨间日记数据库中，最后晨间日记数据库效果如下：
在这里插入图片描述
以上的功能已经满足了基本需求。但是有的时候可能想去修改某一天的日志，如果这时候去数据库中修改，可能不是很方便，没有九宫格看的直观好看，这时候如果开发一个控件，把数据同步过来，并修改，那这样会方便直观很多。
另外，晨间日志的奇迹主要是把今天跟去年的同一天进行对比，这样可以看到自己的进步，从而也可以让自己更有动力去写日志。
整体实现逻辑如下图，首次打开写日记sheet页，在第二个九宫格里展示的是去年的同一天。可以通过年和日的左右控件去切换年和切换日，也可以点击今天或者切换到指定的日期，对应日期的信息会同步到9宫格当中，点击重新编辑会同步信息到第一个九宫格，允许自己重新编辑并存储到晨间日记数据库中。

日期切换宏

如下是日期切换涉及到的宏
在这里插入图片描述

首先是日期切换组件的代码，宏的代码如下

Sub 上一年_Click()
Dim DQdate As Date, NDate As Date, ts As Integer
If Sheets("晨间日记数据库").Range("A2").Value <> "" Then NDate = Sheets("晨间日记数据库").Range("A2")
If Range("AH16").Value <> "" Then DQdate = Range("AH16")
  ts = 1
  If Range("AH16") <> "" And Year(Range("AH16")) > Year(NDate) Then
   Range("AH16") = DateSerial(Year(DQdate) - ts, Month(DQdate), Day(DQdate))
   result = GetDiaryData()
  Else
   MsgBox "您要查询的年份，并没有写日志，过去的让他过去吧"
End If
End Sub
Sub 下一年_Click()
Dim DQdate As Date, ts As Integer
t = Date
If Range("AH16").Value <> "" Then DQdate = Range("AH16")
If Year(Range("AH16")) < Year(t) And Range("AH16") <> "" Then
  Range("AH16") = DateSerial(Year(DQdate) + 1, Month(DQdate), Day(DQdate))
  result = GetDiaryData()
  Else
   MsgBox "未来可期，但要活在当下"
End If
End Sub

Sub 今天_Click()
result = GoToDefault()
End Sub
Sub 上一日_Click()
Dim DQdate As Date, NDate As Date, ts As Integer
If Sheets("晨间日记数据库").Range("A2").Value <> "" Then NDate = Sheets("晨间日记数据库").Range("A2")
If Range("AH16").Value <> "" Then DQdate = Range("AH16")
  ts = 1
  If Range("AH16") <> "" And Range("AH16") > NDate Then
    Range("AH16") = DateSerial(Year(DQdate), Month(DQdate), Day(DQdate) - ts)
    result = GetDiaryData()
  Else
   MsgBox "也许正是这一天，您决定写日志来改变自己，但没来得及记录，无论怎样，好好享受当下吧"
End If
End Sub
Sub 下一日_Click()
Dim DQdate As Date, ts As Integer
t = Date
If Range("AH16").Value <> "" Then DQdate = Range("AH16")
If Range("AH16") < t And Range("AH16") <> "" Then
 Range("AH16") = DateSerial(Year(DQdate), Month(DQdate), Day(DQdate) + 1)
 result = GetDiaryData()
 
Else
   MsgBox "未来可期，但要活在当下"
End If
End Sub

Function GoToDefault() As Variant
        Range("AH16") = DateSerial(Year(Date) - 1, Month(Date), Day(Date))
        result = GetDiaryData()

End Function

下面是代码的详细解释：

Sub 上一年_Click()：这个子程序用于在工作表中显示上一年的晨间日记记录。首先获取当前工作表中的日期值和晨间日记数据库最早日期的日期值。如果最早日期的日期值不为空，则将其赋值给变量 NDate。如果当前选定日期不为空，则将其赋值给变量 DQdate。

如果当前选定日期的年份大于最早日志记录日期的年份，则计算上一年的日期并将其赋值给当前选定日期。接着调用 GetDiaryData() 函数来获取该日期的日志记录，并将返回值赋值给变量 result。

如果当前选定日期的年份小于或等于最早日志记录日期的年份，则弹出消息框提示“您要查询的年份，并没有写日志，过去的让他过去吧”。
Sub 下一年_Click()：这个子程序用于在工作表中显示下一年的晨间日记记录。首先获取当前工作表中的日期值和当前的系统日期值。如果当前选定日期不为空，则将其赋值给变量 DQdate。如果当前选定日期的年份小于系统日期的年份，则计算下一年的日期并将其赋值给当前选定日期。接着调用 GetDiaryData() 函数来获取该日期的日志记录，并将返回值赋值给变量 result。

如果当前选定日期的年份大于或等于系统日期的年份，则弹出消息框提示“未来可期，但要活在当下”。
Sub 今天_Click()：这个子程序用于在工作表中显示今天的晨间日记记录。首先调用 GoToDefault() 函数将当前选定日期设置为去年的今天日期，并获取该日期的日志记录，并将返回值赋值给变量 result。
Sub 上一日_Click()：这个子程序用于在工作表中显示前一天的晨间日记记录。首先获取当前工作表中的日期值和最早日志记录的日期值。如果最早日志记录日期值不为空，则将其赋值给变量 NDate。如果当前选定日期不为空，则将其赋值给变量 DQdate。

如果当前选定日期大于最新日志记录的日期，则计算前一天的日期并将其赋值给当前选定日期。接着调用 GetDiaryData() 函数来获取该日期的日志记录，并将返回值赋值给变量 result。

如果当前选定日期小于或等于最新日志记录的日期，则弹出消息框提示“也许正是这一天，您决定写日志来改变自己，但没来得及记录，无论怎样，好好享受当下吧”。
Sub 下一日_Click()：这个子程序用于在工作表中显示后一天的晨间日记记录。首先获取当前工作表中的日期值和当前的系统日期值。如果当前选定日期不为空，则将其赋值给变量 DQdate。如果当前选定日期小于系统日期，则计算后一天的日期并将其赋值给当前选定日期。接着调用 GetDiaryData() 函数来获取该日期的日志记录，并将返回值赋值给变量 result。

如果当前选定日期大于或等于系统日期，则弹出消息框提示“未来可期，但要活在当下”。
Function GoToDefault()：这个函数用于将当前选定日期设置为去年的今天日期，并获取该日期的日志记录。首先计算去年的今天日期并将其赋值给当前选定日期。接着调用 GetDiaryData() 函数来获取该日期的日志记录，并将返回值赋值给变量 result。

查询宏

代码如下

Sub 查询_Click()
result = GetDiaryData()
End Sub
Function GetDiaryData() As Variant
    
    Dim diarySheet As Worksheet, logSheet As Worksheet
    Dim diaryRange As Range
    Dim logDate As Date, diaryDate As Date, ah17Date As Variant
    Dim dateValue As Date
    
    Dim i As Integer, j As Integer
    
    Set diarySheet = Worksheets("晨间日记数据库")
    Set logSheet = Worksheets("写日记")
    Set diaryRange = diarySheet.Range("A2", diarySheet.Cells(diarySheet.Rows.Count, "A").End(xlUp)).Resize(, 17)
 
    foundDate = False
    
    If Not IsDate(logSheet.Range("AH17").Value) Then
      MsgBox "输入的日期不正确，请重新输入,九宫格将恢复到默认的数据"
      result = GoToDefault()
      Exit Function
    End If
    
    diaryDate = logSheet.Range("AH16").Value
    
    
    
    For i = 1 To diaryRange.Rows.Count
        logDate = diaryRange.Cells(i, 1).Value
        If logDate = diaryDate Then
            logSheet.Range("AH18") = diaryRange.Cells(i, 2).Value
            logSheet.Range("AH19") = diaryRange.Cells(i, 3).Value
            logSheet.Range("AH20") = diaryRange.Cells(i, 4).Value
            logSheet.Range("AH21") = diaryRange.Cells(i, 5).Value
            logSheet.Range("AH22") = diaryRange.Cells(i, 6).Value
            logSheet.Range("AH23") = diaryRange.Cells(i, 7).Value
            logSheet.Range("X5") = diaryRange.Cells(i, 8).Value
            logSheet.Range("AE5") = diaryRange.Cells(i, 9).Value
            logSheet.Range("AL5") = diaryRange.Cells(i, 10).Value
            logSheet.Range("X15") = diaryRange.Cells(i, 11).Value
            logSheet.Range("AL15") = diaryRange.Cells(i, 12).Value
            logSheet.Range("X25") = diaryRange.Cells(i, 13).Value
            logSheet.Range("AE25") = diaryRange.Cells(i, 14).Value
            logSheet.Range("AL25") = diaryRange.Cells(i, 15).Value
            foundDate = True
            Exit For '找到了就退出循环，没有必要继续循环
        End If
    Next i
    
    If Not foundDate Then '循环结束后仍没有找到
        MsgBox "你拥有超能力，但是这个日期的日志实在不存在，将恢复默认日期状态"
        result = GoToDefault()

        
    End If
    
End Function

如上实现了一个查询功能，通过输入日期获取对应的日记数据，具体实现逻辑如下：

获取工作表对象和数据范围对象

首先获取两个工作表对象：‘晨间日记数据库’和’写日记’，并且获取’晨间日记数据库’工作表中日记数据的范围，用diaryRange表示。

遍历日记数据范围

利用For循环遍历diaryRange中每一行的日记数据，获取日记日期logDate，并与输入的日记日期diaryDate进行比较。如果两个日期相等，就将对应的日记数据复制到’写日记’工作表的指定单元格中，并设置foundDate为True表示找到了对应日期的日记。

输入日期不正确

如果输入的日期不正确，弹出提示框提示用户重新输入，并返回到默认的数据状态，即调用GoToDefault()函数。

没有找到对应日期的日记

如果循环结束后仍然没有找到对应日期的日记，弹出提示框提示用户该日期的日志不存在，并返回到默认的数据状态，即调用GoToDefault()函数。

编辑宏

这个宏主要是把右边九宫格的内容同步到左边九宫格，这样可以对指定日期的记录重新编辑，并提交到晨间日志数据库中。代码逻辑如下

Sub 编辑_Click()
 If Range("B5").Value <> "" And Range("i5").Value <> "" And Range("p5").Value <> "" Then
 i = MsgBox("本日内容将在左侧九宫格中编辑，" & Chr(10) & "但是左侧九宫格中已有内容，" & Chr(10) & "是否覆盖？", 4, "警告")
If i = vbNo Then Exit Sub
Range("l16") = Range("AH16")
Range("L18") = Range("AH18")
Range("L19") = Range("AH19")
Range("L20") = Range("AH20")
Range("L21") = Range("AH21")
Range("L22") = Range("AH22")
Range("L23") = Range("AH23")
Range("B5") = Range("X5")
Range("i5") = Range("AE5")
Range("p5") = Range("AL5")
Range("B15") = Range("X15")
Range("p15") = Range("AL15")
Range("B25") = Range("X25")
Range("i25") = Range("AE25")
Range("p25") = Range("AL25")

 
 Else
Range("l16") = Range("AH16")
Range("L18") = Range("AH18")
Range("L19") = Range("AH19")
Range("L20") = Range("AH20")
Range("L21") = Range("AH21")
Range("L22") = Range("AH22")
Range("L23") = Range("AH23")
Range("B5") = Range("X5")
Range("i5") = Range("AE5")
Range("p5") = Range("AL5")
Range("B15") = Range("X15")
Range("p15") = Range("AL15")
Range("B25") = Range("X25")
Range("i25") = Range("AE25")
Range("p25") = Range("AL25")
End If
End Sub

在这个宏中，如果B5、i5和p5单元格中都有值，那么就会出现一个警告询问是否覆盖左侧九宫格中的内容。如果用户点击否，宏就会终止；如果用户点击是，宏就会执行复制右边九宫格的内容到左边。
如果B5、i5和p5单元格中有任何一个是空白的，那么宏就会直接执行以上操作，而不弹出警告提示。

插入图形并关联宏

如上我打造的个人日志系统里的所有组件都是通过，插入菜单，插入形状插入的，插入后可以右击选择指定宏，即可进行关联对应的宏。
在这里插入图片描述
最后对插入的形状进行保护，编辑形状的大小和属性，便完成了该系统的打造。

资源连接

链接：https://pan.baidu.com/s/1IqgaheKn_Y_lOOYcECtq3Q
提取码：atsw

写在后面

这是我第一次使用VB语言编写较多组件，其中可能有一些语法有些冗余，但是可经过测试，基本满足了日常需求。
开发日志系统的目的主要是对自己的日志情况有一个宏观的把控，并且通过Excel进行纵向对比，很容易方便快捷的对比自己有哪些进步，取得了哪些成就。
对于自己目标的实现也可以在日志系统插入一些自己想要达成的目标，比如说如果想打卡一个习惯，可以通过excel标注颜色确定事项的优先级，通过添加列标注目标完成的状态。
Excel在于开源，自己可以写一大堆函数实现个人需求，数据存储也相对安全，个人感觉平时使用Excel写日记其实并不是特别方便。个人习惯喜欢使用一些同步比较快的软件，写日志的时间尽量缩短在三分钟之内。可以使用Microsoft todo等软件，这样自己可以在周末时间把之前写过的日志进行整理省时省力。
在这里插入图片描述