Board logo

標題: [發問]如何找出每月固定一筆資料 [打印本頁]
作者: mfsong    時間: 2014-4-2 13:32     標題: [發問]如何找出每月固定一筆資料

本帖最後由 GBKEE 於 2014-4-2 17:07 編輯

請問已知日期中如何再一堆資料中每月該日期的資料，也就是每月一筆資料？麻煩的是資料是每2~3天不定期一筆，
若找不到該月份的日期資料，就以該日期前日的資料為準，詳附件例子，請各位高手幫忙！！

[attach]17929[/attach]
作者: p212    時間: 2014-4-2 13:55

回復 1# mfsong
從問題的描述與附件看不出您的困擾與期待為何，可否提供預期結果範例？
謝謝！
作者: mfsong    時間: 2014-4-2 17:44

回復 2# p212


Sorry, 前面說明不清楚；補充如後：來源資料是但是每隔2~3天一筆之連續數月的資料，希望輸入固定一天資訊後，之後能整理出該月的當天資料，
例如：輸入13，希望整理出1/13, 2/13, 3/13,.....的每行資料，其中若無2/13，則往前推2/12資料為準。
以上說明。
作者: Hsieh    時間: 2014-4-3 10:22

回復 3# mfsong
  1. Sub ex()
  2. Dim Mydate#, d%, Rng As Range, A As Range
  3. d = InputBox("輸入基準日", , 13)
  4. ym = Format([B1], "yyyy/")
  5. Set Rng = UsedRange.Columns(1)
  6. For i = 1 To 12
  7.   Mydate = DateValue(ym & i & "/" & d)
  8.   k = d
  9.   Do Until IsNumeric(Application.Match(Mydate, Rows(1), 0))
  10.   k = k - 1
  11.   If k < 1 Then GoTo 10
  12.   Mydate = DateValue(ym & i & "/" & k)
  13.   Loop
  14.   Mydate = DateValue(ym & i & "/" & k)
  15.   Set A = UsedRange.Columns(Application.Match(Mydate, Rows(1), 0))
  16.   Set Rng = Union(Rng, A)
  17. 10
  18. Next
  19. Rng.Select '選取資料範圍
  20. End Sub
複製代碼
作者: mfsong    時間: 2014-4-3 13:54

回復 4# Hsieh

Exactly!  程式很精簡，不過資料無法處理跨年說...謝謝了！
作者: GBKEE    時間: 2014-4-3 16:45

回復 5# mfsong
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Mydate As Double, d As Integer, Rng As Range, A As Range, yy As Integer, i As Integer, k As Integer
  4.     d = InputBox("輸入基準日", , 13)
  5.     Set Rng = UsedRange.Columns(1)
  6.     For yy = Year([B1]) To Year([B1].End(xlToRight))        '年度
  7.         For i = 1 To 12                                     '月份
  8.             For k = d To 1 Step -1                          '往前找日期
  9.                 Mydate = DateValue(yy & "/" & i & "/" & k)
  10.                 If IsNumeric(Application.Match(Mydate, Rows(1), 0)) Then
  11.                     Set A = UsedRange.Columns(Application.Match(Mydate, Rows(1), 0))
  12.                     GoTo 10
  13.                 End If
  14.             Next
  15.             For k = d + 1 To Day(DateAdd("m", 1, DateValue(yy & "/" & i)) - 1) '往後找日期
  16.                 Mydate = DateValue(yy & "/" & i & "/" & k)
  17.                 If IsNumeric(Application.Match(Mydate, Rows(1), 0)) Then
  18.                     Set A = UsedRange.Columns(Application.Match(Mydate, Rows(1), 0))
  19.                     GoTo 10
  20.                 End If
  21.             Next
  22. 10
  23.             If Not A Is Nothing Then Set Rng = Union(Rng, A)
  24.             Set A = Nothing
  25.         Next
  26.     Next
  27.     Rng.Select '選取資料範圍
  28. End Sub
複製代碼
作者: mfsong    時間: 2014-4-3 17:55

回復 6# GBKEE


謝謝版主！問題解決了！我曾自己嘗試解決，因很多指令不熟，使得程式搞得很複雜，但看得各位高手式子又短，羨慕各位功力！
THANKS！！



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)