标签：
野生程序猿 | 发表时间：2023-08-01 13:08:25 | 更新时间： 2023-08-01 13:26:05 | 阅读数：308 | 评论数：0 | 字数：1295
我每年要写大量的工作日志（日记），去年写了16万多字（见
这里），今年也写了5万多。日志是以时间顺序记录的，每天发生了啥，事无巨细都有记录，有点儿像编年体的历史。但是，众所周知编年体有个缺点，就是想要了解某一个人的事情，因为散落在各个时间里，寻找起来就比较麻烦了。我这日志也有这个缺点，要想了解某个项目的过程，需要搜索关键词，虽然搜索很迅速，但阅读起来难免困难。
于是就产生了将和某关键字（比如项目名称）相关的内容按时间顺序从这十几万字中梳理出来的需求。换句话说，就是给这个关键字（也可以说某项目）写个纪传体的历史。
日志是在石墨文档中写的，石墨文档不支持编程，但可导出到word。用VBA写这种单一功能的程序比较适合。
下面的动图就是成果示例，结果还是比较完美的。
写这段程序时，使用了ChatGPT。应该说ChatGPT对我这种半瓶子醋的编程爱好者十分有用，只要能描述清楚需求，它就能给出你完整的示例。我再也不用满世界的各种搜索了，在编程过程中几乎用不到传统搜索，编程过程能够节省大量的时间。
这对某度甚至某歌之类的上一代搜索引擎确实是降维打击。
原文2023年7月19日发表于微博，有改动
动图效果如下：（不清晰的话，可以右键在新标签中打开图像）
代码如下：
（下载代码文件）
'2023-07-19编写完成第1版
Sub xxx()
Dim rng As Range
Dim paragraph As String
Dim strDate As String
Dim result As String
Dim strSearch As String
Dim isIndentation As Boolean '判断这一段是否缩进
strSearch = InputBox("输入搜索内容：", , "项目A")
isIndentation = False
' 设置搜索范围为整个文档
Set rng = ActiveDocument.content
' 遍历每个段落
For Each para In rng.Paragraphs
'判断是否有缩进
If para.FirstLineIndent <> 0 And isIndentation = True Then
' 如果这一段有缩进，并且isIndentation是真，那么就说明这一段是需要的内容
result = result & "□" & para.Range.Text
'下一段还需要继续判断是否缩进，所以设置成真。
isIndentation = True
GoTo 100 '跳过这个循环的其余部分，判断下一段（防止缩进文本中也有搜索关键词导致内容重复）
Else
'如果这一段没有缩进，或者isIndentation是假，那么就设置
isIndentation = False
End If
' 判断段落是否包含“日”、“月”
If InStr(para.Range.Text, "日") > 0 And InStr(para.Range.Text, "月") > 0 _
And InStr(para.Range.Text, "周") > 0 Then
' 将满足条件的段落保存到结果变量中
strDate = Left(para.Range.Text, 9) & vbCrLf
End If
'搜索关键字
If InStr(para.Range.Text, strSearch) > 0 Then
result = result & strDate & para.Range.Text
strDate = "" '将strdate设置为空，因为在某个日期下可能存在多个结果，不设置成空就会每一个结果带一个日期。
isIndentation = True '这里搜索到了目标文本，需要在下一段判断是否是缩进，若是缩进的，那么也是目标文本。
End If
100
Next para
' 将文本复制到剪贴板
With New DataObject
.SetText result
.PutInClipboard
End With
MsgBox result
MsgBox "完成！查询结果已复制到剪贴板。", , "完成"
End Sub
