標題:
[發問]
找出每個群組中,日期最靠近今天的列
[打印本頁]
作者:
gameshop
時間:
2013-5-16 23:00
標題:
找出每個群組中,日期最靠近今天的列
各位先進好
最近在整理一個有兩萬列的Excel
目標是每天會自動抓出最靠近今天日期的資料(但不包含未來)
資料範例如下
群組 日期 數值
A 2012/12/15 15
A 2013/1/17 16
A 2013/5/15 10
A 2014/2/12 49
B 2012/2/3 20
B 2013/4/25 30
B 2014/5/22 50
C 2011/3/3 20
C 2012/2/13 5
例如今天是2013/5/16
則結果則跑出
A 2013/5/15 10
B 2013/4/25 30
C 2012/2/13 5
目前想法是用Today()減掉日期欄位,再取出各群組中min( 大於或等於零的數)
再將那一列抓至新的Worksheet
但不知道如何針對各群組分別進行
請各位先進幫忙指點
非常感謝!!
作者:
Hsieh
時間:
2013-5-16 23:32
回復
1#
gameshop
Sub ex()
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
d1("群組") = Array("群組", "日期", "數值")
With Sheets(1)
For Each a In .Range(.[A2], .[A2].End(xlDown))
s = Date - a.Offset(, 1)
d(a.Value) = IIf(IsEmpty(d(a.Value)), s, d(a.Value))
If s > 0 And d(a.Value) > s Then
d(a.Value) = s
d1(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value)
End If
Next
End With
Sheets(2).[E1].Resize(d1.Count, 3) = Application.Transpose(Application.Transpose(d1.items))
End Sub
複製代碼
作者:
gameshop
時間:
2013-5-17 00:16
謝謝前輩分享
程式可以使用
但如果我每一列資料都很長,該如何修改呢
我將 d1(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value,a.Offset(, 3).Value )
往後加一個格子,跑出來會有型態錯誤(應該是下列這行)
Sheets(2).[E1].Resize(d1.Count, 3) = Application.Transpose(Application.Transpose(d1.items))
抱歉因為看不懂這些程式碼,所以無法自行修改
想請教前輩
1.IIf跟IF有什麼差別呢
2.CreateObject函數是什麼呢
另外,我在程式碼中找不到針對各"群組"進行分析的程式碼
請問前輩是怎麼達到結果的呢
抱歉好像問題有點多
非常感謝
作者:
gameshop
時間:
2013-5-17 00:24
抱歉前輩
發現一個問題
若該群組的第一個資料點就是當天的話
結果會缺了該群組資料
請問該怎麼修正呢
謝謝前輩
作者:
gameshop
時間:
2013-5-17 00:31
抱歉前輩
我發現我沒有把需要的結果說清楚
其實應該還要加一個條件
如果該群組沒有過去時間的資料
則改抓最接近的未來時間點的資料
If s >= 0 And d(a.Value) > s Then 這行想不出來要怎麼改
真的很麻煩您
謝謝前輩
作者:
Hsieh
時間:
2013-5-17 10:33
回復
5#
gameshop
Sub ex()
Set d = CreateObject("Scripting.Dictionary") '創建字典物件紀錄群組日期差
Set d1 = CreateObject("Scripting.Dictionary") '創建字典物件紀錄群組最小日期差
With Sheets(1) '資料工作表
ar = .Range("A1").CurrentRegion '資料所有範圍記錄到陣列
d1(ar(1, 1)) = Application.Index(ar, 1) '建立標題列
For i = 2 To UBound(ar, 1) '從第2列開始迴圈
s = Date - ar(i, 2) '日期差
If s >= 0 Then '日期差為正值
If IsEmpty(d(ar(i, 1))) Then d(ar(i, 1)) = s '假如群組還沒資料,就將日期差加入群組
If s <= d(ar(i, 1)) Then d(ar(i, 1)) = s: d1(ar(i, 1)) = Application.Index(ar, i) '比較日期差後記錄該列資料到字典對應群組內
End If
Next
End With
Sheets(2).Range("A1").CurrentRegion.ClearContents '清除舊有資料
Sheets(2).[A1].Resize(d1.Count, UBound(ar, 2)) = Application.Transpose(Application.Transpose(d1.items)) '寫入資料
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)