用VBA实现日期格式转换并删除重复记录

zdj365

用VBA实现：
1、将B列时间变成YYYY-MM-DD的格式
2、删除重复记录
打卡记录.rar (17.73 KB, 下载次数: 21)

2019-9-6 15:24 上传

点击文件名下载附件

求代码

Jaofuan

1. Sub jaofuan()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.Range("A1").CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To 3)
   
5.     For i = 2 To UBound(arr)
   
6.         If Not d.exists(arr(i, 1) & Format(arr(i, 2), "YYYY-MM-DD")) Then
   
7.             p = p + 1
   
8.             d(arr(i, 1) & Format(arr(i, 2), "YYYY-MM-DD")) = h
   
9.             brr(p, 1) = arr(i, 1)
   
10.             brr(p, 2) = Format(arr(i, 2), "YYYY-MM-DD")
    
11.             brr(p, 3) = arr(i, 3)
    
12.         End If
    
13.     Next
    
14.     Range("A2:c" & Rows.Count) = "" '清空原有的数据
    
15.     [a2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
    
16. End Sub

复制代码

zdj365

没有备注的，是我看不懂的，您可以帮我备注一下注释吗？

Sub jaofuan() '过程开始
    Set d =CreateObject("scripting.dictionary") '创建对象D
    arr =Sheet1.Range("A1").CurrentRegion '字典范围
    ReDim brr(1 To UBound(arr), 1To 3) '重新定义数组下标。第一个参数是这个表格有几行。第二个参数是已知有3列。
    For i = 2 To UBound(arr) '从第2个开始循环，直到最后一行
        IfNot d.exists(arr(i, 1) & Format(arr(i, 2), "YYYY-MM-DD")) Then      
           p = p + 1
           d(arr(i, 1) & Format(arr(i, 2), "YYYY-MM-DD"))= h
           brr(p, 1) = arr(i, 1)
           brr(p, 2) = Format(arr(i, 2), "YYYY-MM-DD")
           brr(p, 3) = arr(i, 3)
        EndIf '判断结束
    Next '循环结束
    Range("A2:c" &Rows.Count) = "" '清空原有的数据
    [a2].Resize(UBound(brr, 1),UBound(brr, 2)) = brr
End Sub '过程结束

opel-wong

zdj365 发表于 2019-9-6 18:10
没有备注的，是我看不懂的，您可以帮我备注一下注释吗？

Sub jaofuan() '过程开始

供参考：

1. Sub jaofuan()
   
2.     Set d = CreateObject("scripting.dictionary") '创建字典
   
3.     arr = Sheet1.Range("A1").CurrentRegion '将数据区域赋值于数组
   
4.     ReDim brr(1 To UBound(arr), 1 To 3) '重新定义数组范围
   
5.     For i = 2 To UBound(arr) '从第2个开始循环，直到最后一行
   
6.     ' 将职位 & 打卡日期，组合一个字符串，判断是否在字典中存在
   
7.         If Not d.exists(arr(i, 1) & Format(arr(i, 2), "YYYY-MM-DD")) Then
   
8.            p = p + 1  ' 计数
   
9.            d(arr(i, 1) & Format(arr(i, 2), "YYYY-MM-DD")) = h  ' 将职位 & 打卡日期，组合一个字符串，加入字典
   
10.            brr(p, 1) = arr(i, 1)  ' 数组转换赋值，职位
    
11.            brr(p, 2) = Format(arr(i, 2), "YYYY-MM-DD") ' 数组转换赋值，将转换为日期格式，日期
    
12.            brr(p, 3) = arr(i, 3) ' 数组转换赋值，星期
    
13.         End If
    
14.     Next '循环结束
    
15.     Range("A2:c" & Rows.Count) = "" '清空原有的数据
    
16.     [a2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr ' 将brr数组中的数组一次性写入到单元格区域
    
17. End Sub

复制代码

opel-wong

这样，可能更直观些：

大灰狼1976

1. Sub test()
   
2. With [b2:b520]
   
3.   .NumberFormatLocal = "yyyy-mm-dd"
   
4.   .Value = ["=datevalue("""&b2:b520&""")"]
   
5.   .Value = .Value
   
6. End With
   
7. [a2:c520].RemoveDuplicates Columns:=Array(1, 2, 3)
   
8. End Sub

复制代码