返回列表 上一主題 發帖

[發問] 輸入數值後，如何啟動自動下拉一格的機制?

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2015-7-24 06:20 | 顯示全部帖子
本帖最後由 GBKEE 於 2015-7-24 06:21 編輯

回復 14# finally0130

試試看
第6帖檔案的程式碼
  1. Option Explicit
  2. Dim x_Mon As Integer, x_Week As Integer
  3. Sub Ex()
  4.     Dim R As Long, E As Variant, t As Date
  5.     t = Time
  6.     Range("F4:Z" & Rows.Count) = "" '清除舊有資料 Rows.Count 範圍的列總數,這裡為工作表範圍
  7.    
  8.     R = Range("D4").End(xlDown).Row '日平均價的最後一列號
  9.     With Range("B4:B" & R)          '月別範圍
  10.         .Cells = "=MONTH(RC[2])"    '工作表上寫入函數,[R1C1]工作表上欄名列名表示法
  11.         .Value = .Value             '公式轉值
  12.     End With
  13.     With Range("C4:C" & R)          '周別範圍
  14.         .Cells = "=WEEKNUM(RC[1])"  '2003: 增益集須加入 VBA分析工具箱
  15.         .Value = .Value
  16.     End With
  17.     x_Week = DatePart("ww", Range("D4")) 'VBA的週別函數
  18.     x_Mon = Month(Range("D4"))           'VBA的月別函數
  19.    
  20.     For Each E In Range("D4:D" & R)      '日期範圍
  21.         週月收盤價 E                     '呼叫 Sub 週月收盤價 E(傳遞參數)
  22.         x_Week = DatePart("ww", E)       '再讀當週
  23.         x_Mon = Month(E)                 '再讀當月
  24.     Next
  25.     均價      '呼叫 Sub 均價
  26.     MsgBox Application.Text(Time - t, "共計執行 [s] 秒")
  27. End Sub
  28. Sub 均價()
  29.     Dim Rng As Range, E As Variant,  i As Integer, AR()
  30.     AR = Array(5, 10, 20, 60, 120)
  31.     For Each E In Array("F4", "N4", "V4")   '日平均價,周平均價,月平均價的第一個欄位
  32.         Set Rng = Range(E).Resize(Range(E).Offset(, -1).End(xlDown).Row - 3, 5)
  33.         For i = 0 To UBound(AR)
  34.             With Rng.Columns(i + 1) '均價範圍的每一個欄位範圍
  35.                 If .Rows.Count > AR(i) Then  '範圍小於均價日數 下面的With會有錯誤
  36.                     With .Cells(AR(i)).Resize(.Rows.Count - AR(i) + 1)
  37.                         .Cells = "=Average(RC[" & -i + -1 & "]:R[" & -AR(i) + 1 & "]C[" & -i + -1 & "])"
  38.                         '工作表上寫入公式
  39.                     End With
  40.                 End If
  41.             End With
  42.         Next
  43.         Rng.Value = Rng.Value  '轉公式為值
  44.     Next
  45. End Sub
  46. Sub 週月收盤價(E As Variant) '讀取到:周收盤價,月收盤價
  47.     If x_Week <> DatePart("ww", E) Then  '不同週數
  48.         With Range("L" & Rows.Count).End(xlUp).Offset(1)
  49.             .Resize(, 2) = E.Offset(-1).Resize(, 2).Value 'E的上一列
  50.             .Cells(1, 0) = DatePart("ww", E.Offset(-1))
  51.         End With
  52.     End If
  53.     If x_Mon <> Month(E) Then           '不同月數
  54.         With Range("T" & Rows.Count).End(xlUp).Offset(1)
  55.             .Resize(, 2) = E.Offset(-1).Resize(, 2).Value
  56.             .Cells(1, 0) = Month(E.Offset(-1))
  57.         End With
  58.     End If
  59. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題