楼主
liuguansky |
Q：如何在一列日期数据中提取每个月的最后期记录？[假设日期数据为乱序排列]
A：用如下代码可以实现：
- Sub justtest()
- Dim dic, arr, i&, str1$, str2$, str3, arrt, arrre, j&
- Set dic = CreateObject("scripting.dictionary")
- arr = Cells(1, 1).CurrentRegion
- For i = 2 To UBound(arr, 1)
- str1 = Format(arr(i, 3), "yyyy-m")
- str2 = Format(arr(i, 3), "d")
- str3 = arr(i, 1) & vbTab & arr(i, 2) & vbTab & arr(i, 3)
- If dic.exists(str1) Then
- If Val(Format(Split(dic(str1), vbTab)(2), "d")) <= Val(str2) Then
- dic(str1) = str3
- End If
- Else: dic.Add str1, str3
- End If
- Next i
- Range("e:g").Clear
- Cells(1, "e").Resize(1, 3) = Application.Index(arr, 1)
- If dic.Count > 0 Then
- arrt = dic.items
- ReDim arrre(1 To dic.Count, 1 To 3)
- For i = 1 To dic.Count
- For j = 1 To 3
- arrre(i, j) = Split(arrt(i - 1), vbTab)(j - 1)
- Next j, i
- Cells(2, "e").Resize(i - 1, 3) = arrre
- End If
- Set dic = Nothing
- End Sub
|
2楼
wqfzqgk |
- Sub ddddd()
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a210:c2")
- For i = 1 To 209
- d(Split(arr(i, 3), "/")(0) & Split(arr(i, 3), "/")(1)) = arr(i, 1) & "%" & arr(i, 2) & "%" & arr(i, 3)
- Next
- Range("h2").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(d.items)
- Application.DisplayAlerts = False
- Range("h:h").TextToColumns other:=True, otherchar:="%"
- Application.DisplayAlerts = True
- End Sub
有个小缺点，和上面的程序一样，如果有相同的最大日期的话，只能提一个，呵呵，对了我这个忘了一开始排序啦，不然的话，乱序就不对，只是一句代码 |