EXCEL + VBA， 按照一切数据均可处理的原则。 这俩组合给非码工提交使用还是不错的。 今天遇上了一个有意思的case： Excel遍历不符合预期， 不得不多轮遍历处理数据。记录备需。

详情如下：

客户（免费帮忙校友）的需求如下：

数据（输入）

数据表格通过Excel格式存储，仅一页数据， 多列。 首列是名单，title： “User Principal Name”， 其余多列为登陆日期数据， 日期以String存储，如 “7/14/2021”

需求

写一个Excel Micro， 通过运行它， 可以：

• 直接修改当前表格
• 遍历所有日期数据，仅保留一个月的以前的登陆用户记录
• 按照字母序排序

题外话

老实说，提到数据处理，我更喜欢用python。 上次写VBA都是近九年前的旧事了。 但是python需要配置，对于非码工 Excel 的 Micro确实更友好。 按照需求写，不纠结。

VBA代码实现

分段功能

建立变量：上月日期，用于对比

    Dim mBefore As Date
       mBefore = Format(DateAdd("m", -1, Date), "dd mmmm yyyy")
       Debug.Print mBefore

遍历整表：

    Dim wsSrc As Worksheet: Set wsSrc = ActiveSheet
    Dim del As Boolean
    
    Dim LastRow As Long: LastRow = wsSrc.UsedRange.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim LastCol As Long: LastCol = wsSrc.UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    With wsDest
        For i = 2 To LastRow
            For j = 2 To LastCol
                If Cells(i, j).Value > mBefore Then
                    Rows(i).Delete
                End If
            Next j
        Next i
    End With

高亮选中cell：用于数据验证分析

    Cells(i, j).Font.Color = vbRed

实际设计

版一： 遍历 + 遇到日期大于上个月 -> 删除本行

实际结果： 有数据没有被删除

版二： 遍历 + 遇到日期大于上个月 -> 高亮； 再次遍历， 遇到高亮 -> 删除本行

实际结果： 依然有数据行没有被删除

版三： （遍历 + 遇到日期大于上个月 -> 高亮； 再次遍历， 遇到高亮 -> 删除本行） * 2 轮

数据验证通过。 以下为最终代码：

Sub Delete_Date_After()
    Dim mBefore As Date
       mBefore = Format(DateAdd("m", -1, Date), "dd mmmm yyyy")
       Debug.Print mBefore
       
    Dim wsSrc As Worksheet: Set wsSrc = ActiveSheet
    Dim del As Boolean
    
    Dim LastRow As Long: LastRow = wsSrc.UsedRange.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim LastCol As Long: LastCol = wsSrc.UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    With wsDest
        For i = 2 To LastRow
            For j = 2 To LastCol
                If Cells(i, j).Value > mBefore Then
                    Cells(i, j).Font.Color = vbRed
                End If
            Next j
        Next i
    End With
    With wsDest
        For i = 2 To LastRow
            For j = 2 To LastCol
                If Cells(i, j).Font.Color = vbRed Then
                    Rows(i).Delete
                End If
            Next j
        Next i
    End With
    With wsDest
        For i = 2 To LastRow
            For j = 2 To LastCol
                If Cells(i, j).Value > mBefore Then
                    Cells(i, j).Font.Color = vbRed
                End If
            Next j
        Next i
    End With
    With wsDest
        For i = 2 To LastRow
            For j = 2 To LastCol
                If Cells(i, j).Font.Color = vbRed Then
                    Rows(i).Delete
                End If
            Next j
        Next i
    End With
End Sub

标签：Dim,VBA,End,EXCEL,用户,Next,mBefore,LastCol,LastRow
来源： https://www.cnblogs.com/robinali/p/15155656.html