返回列表 上一主題 發帖

[發問] 找出每個群組中，日期最靠近今天的列

gameshop

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
WIN7 
軟體版本
Office 2007 
閱讀權限
10 
註冊時間
2013-5-16 
最後登錄
2013-5-16 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
270  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-11-4 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2013-5-16 23:32 | 只看該作者
回復 1# gameshop
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. d1("群組") = Array("群組", "日期", "數值")
  5. With Sheets(1)
  6. For Each a In .Range(.[A2], .[A2].End(xlDown))
  7.    s = Date - a.Offset(, 1)
  8.    d(a.Value) = IIf(IsEmpty(d(a.Value)), s, d(a.Value))
  9.    If s > 0 And d(a.Value) > s Then
  10.          d(a.Value) = s
  11.          d1(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value)
  12.    End If
  13. Next
  14. End With
  15. Sheets(2).[E1].Resize(d1.Count, 3) = Application.Transpose(Application.Transpose(d1.items))
  16. End Sub
複製代碼
學海無涯_不恥下問

TOP

gameshop

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
WIN7 
軟體版本
Office 2007 
閱讀權限
10 
註冊時間
2013-5-16 
最後登錄
2013-5-16 
3#
發表於 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函數是什麼呢
另外，我在程式碼中找不到針對各"群組"進行分析的程式碼
請問前輩是怎麼達到結果的呢

抱歉好像問題有點多

非常感謝

TOP

gameshop

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
WIN7 
軟體版本
Office 2007 
閱讀權限
10 
註冊時間
2013-5-16 
最後登錄
2013-5-16 
4#
發表於 2013-5-17 00:24 | 只看該作者
抱歉前輩
發現一個問題
若該群組的第一個資料點就是當天的話
結果會缺了該群組資料
請問該怎麼修正呢

謝謝前輩

TOP

gameshop

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
WIN7 
軟體版本
Office 2007 
閱讀權限
10 
註冊時間
2013-5-16 
最後登錄
2013-5-16 
5#
發表於 2013-5-17 00:31 | 只看該作者
抱歉前輩
我發現我沒有把需要的結果說清楚
其實應該還要加一個條件

如果該群組沒有過去時間的資料
則改抓最接近的未來時間點的資料
If s >= 0 And d(a.Value) > s Then 這行想不出來要怎麼改

真的很麻煩您

謝謝前輩

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
270  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-11-4 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2013-5-17 10:33 | 只看該作者
回復 5# gameshop
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary") '創建字典物件紀錄群組日期差
  3. Set d1 = CreateObject("Scripting.Dictionary") '創建字典物件紀錄群組最小日期差

  5. With Sheets(1) '資料工作表
  6. ar = .Range("A1").CurrentRegion '資料所有範圍記錄到陣列
  7. d1(ar(1, 1)) = Application.Index(ar, 1) '建立標題列
  8.   For i = 2 To UBound(ar, 1) '從第2列開始迴圈
  9.   s = Date - ar(i, 2) '日期差
  10.   If s >= 0 Then '日期差為正值
  11.      If IsEmpty(d(ar(i, 1))) Then d(ar(i, 1)) = s '假如群組還沒資料，就將日期差加入群組
  12.      If s <= d(ar(i, 1)) Then d(ar(i, 1)) = s: d1(ar(i, 1)) = Application.Index(ar, i) '比較日期差後記錄該列資料到字典對應群組內
  13.   End If
  14.   Next
  15. End With
  16. Sheets(2).Range("A1").CurrentRegion.ClearContents '清除舊有資料
  17. Sheets(2).[A1].Resize(d1.Count, UBound(ar, 2)) = Application.Transpose(Application.Transpose(d1.items)) '寫入資料
  18. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 天上最美是星星，人生最美是溫情。
返回列表 上一主題