12
返回列表 上一主題 發帖

[發問] (已解決)計算最近一次漲跌價幅度

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-6-21 17:43 | 只看該作者

[發問] (已解決)計算最近一次漲跌價幅度

本帖最後由 freeffly 於 2012-2-22 17:00 編輯

如附檔
我想用最新的月份(用月份那一列判斷，還沒到的月份不會顯示)
與前一次交易的月份的價格作計算
請問這各要怎麼寫?

最近一次價格交易漲跌幅度.rar (2.12 KB)
收藏 分享
字典兩各字 還真難理解

luhpro

帖子
824 
主題
6 
精華
0 
積分
904 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2023-12-24 
2#
發表於 2011-6-23 00:27 | 只看該作者
  1. Sub nn()
  2.   Dim lRow As Long
  3.   
  4.   lRow = Rows.Count
  5.   Do Until lRow = 1
  6.     lRow = Cells(lRow, 13).End(xlUp).Row
  7.     If Cells(lRow, 12) <> 0 And Cells(lRow, 12) <> "" Then
  8.       Cells(lRow, 14) = (Cells(lRow, 13) - Cells(lRow, 12)) / Cells(lRow, 12)
  9.     Else
  10.       Cells(lRow, 14) = (Cells(lRow, 13) - Cells(lRow, Cells(lRow, 13).End(xlToLeft).Column)) / Cells(lRow, Cells(lRow, 12).End(xlToLeft).Column)
  11.     End If
  12.     lRow = lRow - 1
  13.   Loop
  14. End Sub
複製代碼

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
3#
發表於 2011-6-23 12:34 | 只看該作者
回復 2# luhpro


    這各方式可以
      不過我想問一下如果最近一次不是在最後一欄
      這種方式要如何改?
字典兩各字 還真難理解

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2011-6-23 16:14 | 只看該作者
本帖最後由 GBKEE 於 2011-7-29 20:25 編輯

回復 3# freeffly
  1. Sub Ex()
  2. Dim C() As Integer, i As Integer, ii As Integer
  3. For i = 2 To Cells(Rows.Count, "M").End(xlUp).Row
  4. '迴圈 從第2列開始  到(To)  M欄最底端(Rows.Count) 往上到有資料(End(xlUp))的列號
  5.     If Application.CountA(Cells(i, "B").Resize(, 12)) >= 2 Then 'B欄Resize(擴充)12欄: 到M欄
  6.         ReDim C(1) As Integer                    '重新宣告陣列
  7.         For ii = 13 To 2 Step -1                  '迴圈 間隔(Step) -1 :由大往小 (下)
  8.             If Cells(i, ii) <> "" Then
  9.                 If (C(0)) = 0 Then
  10.                     C(0) = Cells(i, ii)
  11.                 ElseIf C(1) = 0 Then
  12.                     C(1) = Cells(i, ii)
  13.                 End If
  14.                 If C(0) <> 0 And C(1) <> 0 Then   '找到最接近的兩數
  15.                     Cells(i, "N") = (C(0) - C(1)) / C(1)
  16.                     Exit For
  17.                 End If
  18.             End If
  19.         Next
  20.     End If
  21. Next
  22. End Sub
複製代碼

TOP

luhpro

帖子
824 
主題
6 
精華
0 
積分
904 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2023-12-24 
5#
發表於 2011-6-28 22:07 | 只看該作者
本帖最後由 luhpro 於 2011-6-28 22:09 編輯

回復 3# freeffly
那就變成從最末一列到第二列都要執行.
然後先判斷 12 月那欄是否有資料,
若有則執行原先程式中的那個片段,
若無則往左尋找最末兩筆資料,
若此兩筆資料其中一筆在 A 欄則不做任何計算, (因 A 攔不是我們要計算的資料)
否則就將此兩欄資料做相應的計算, 程式如下:
  1. Sub nn()
  2.   Dim iCol1%, iCol2%
  3.   Dim lRows As Long, lRow As Long
  4.   
  5.   lRows = Cells(Rows.Count, 1).End(xlUp).Row
  6.   For lRow = lRows To 2 Step -1
  7.     If Cells(lRow, 13) <> 0 And Cells(lRow, 13) <> "" Then
  8.       If Cells(lRow, 12) <> 0 And Cells(lRow, 12) <> "" Then
  9.         Cells(lRow, 14) = (Cells(lRow, 13) - Cells(lRow, 12)) / Cells(lRow, 12)
  10.       Else
  11.         Cells(lRow, 14) = (Cells(lRow, 13) - Cells(lRow, Cells(lRow, 13).End(xlToLeft).Column)) / Cells(lRow, Cells(lRow, 12).End(xlToLeft).Column)
  12.       End If
  13.     Else
  14.       iCol1 = Cells(lRow, 13).End(xlToLeft).Column
  15.       iCol2 = Cells(lRow, iCol1).End(xlToLeft).Column
  16.       If iCol1 <> 1 And iCol2 <> 1 Then
  17.         Cells(lRow, 14) = (Cells(lRow, iCol1) - Cells(lRow, iCol2)) / Cells(lRow, iCol2)
  18.       End If
  19.     End If
  20.   Next lRow
  21. End Sub
複製代碼

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
6#
發表於 2011-7-29 16:51 | 只看該作者
回復 5# luhpro


    看起來相當複雜喔
        謝謝大大回覆
        先收下來研究
字典兩各字 還真難理解

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
7#
發表於 2011-7-29 16:52 | 只看該作者
回復 4# GBKEE


    謝謝大大回覆
      一樣先收下來試試看
字典兩各字 還真難理解

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
8#
發表於 2011-7-29 17:12 | 只看該作者
回復 4# GBKEE


    兩位的方式都可以執行
       不過大大的方式比較簡單一點
      有一些方式沒用過
      不知道大大可以大略講解一下嗎
字典兩各字 還真難理解

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
9#
發表於 2011-8-2 14:54 | 只看該作者
回復 4# GBKEE

謝謝大大註解

ReDim C(1) As Integer                    '重新宣告陣列

請問這裡為什麼要重新宣告?
重新宣告時C()裡面放1或0有沒有差?
字典兩各字 還真難理解

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2011-8-2 15:47 | 只看該作者
回復 9# freeffly
If Application.CountA(Cells(i, "B").Resize(, 12)) >= 2 Then 'B欄Resize(擴充)12欄: 到M欄
上式 是檢查 到有2個數字以上
        ReDim C(1) As Integer        '重新宣告陣列   ->歸零    C(0), C(1) 設定最右邊最接近的2個數字

TOP

        靜思自在 : 【蒙蔽的自由】人常在什麼都可以自由自在的時候，卻被這種隨心所欲的自由蒙蔽，虛擲時光而毫無覺知。
12
返回列表 上一主題