首页 > 其他分享> 文章详细

小记：EXCEL + VBA 用户记录：保留一个月的以前的登陆用户

2021-08-18 10:32:02 阅读：273 来源： 互联网

标签：Dim VBA End EXCEL 用户 Next mBefore LastCol LastRow

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

本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享；
2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关；
3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关；
4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除；
5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。

ICode9