Excel应用实践24： 实现完美Excel公众号文章推送记录

Private Sub Worksheet_Change(ByVal Target As Range)
    '工作表变量
    Dim wksUnPublish AsWorksheet
    Dim wksPublished AsWorksheet
    '工作表中最后一行
    Dim lngLastRow As Long
    '当前单元格所在行
    Dim lngCurRow As Long
    '信息框响应
    Dim iMsg As Integer
   
    '获取当前行行号
    lngCurRow = Target.Row
 
    '当前单元格在列C,或值为空或"否",则退出
    If Intersect(Target,Range("C:C")) Is Nothing Or _
       Range("C"& lngCurRow) = "" Or _
       Range("C"& lngCurRow) = "否" Then Exit Sub
   
    '赋值工作表
    Set wksUnPublish =Worksheets("待发表")
    Set wksPublished =Worksheets("已发表")
   
    '获取"已发表"工作表最后一行行号
    lngLastRow =wksPublished.Range("B" & Rows.Count).End(xlUp).Row
   
    '当前行列D中单元格值为"是"且列A和列B中的值不为空
    If Range("C"& lngCurRow) = "是" And _
       Range("A"& lngCurRow) <> "" And _
       Range("B"& lngCurRow) <> "" Then
       
        '弹出询问信息框并获取用户所选值
        iMsg = MsgBox("要推送这篇文章吗?", vbYesNo)
       
        '如果用户单击"是"
        If iMsg = vbYes Then
            '将当前行复制到"已发表"工作表相应行
            wksUnPublish.Range("A" &lngCurRow & ":B" & lngCurRow).Copy _
             wksPublished.Range("B" & lngLastRow + 1)
            '输入序号
           wksPublished.Range("A" & lngLastRow + 1) = lngLastRow
            '输入日期
           wksPublished.Range("D" & lngLastRow + 1).Value = Date
            '删除"待发表"工作表中相应行
           wksUnPublish.Range("A" & lngCurRow).EntireRow.Delete
        Else
            '如果用户单击"否"
           Range("C" & lngCurRow).Value = "否"
        End If
    End If
End Sub