VBA：計算月均價與期底

是否跟小編一樣，有計算月均價的需要，最近小編在計算某貴金屬的月均價，本來想用EXCEL的AVERAGE函數拉一下就好，但似乎期間很阿雜，就寫了個VBA函數來"處理"

VBA CODE：

月均價：

	Sub AVERAGE_BY_MONTHLY(MONTHLY, DATA, WRITTEN1, WRITTEN2) '月平均，a是關鍵字 a行是資料b行是資料回寫在c跟d
	' Turn off Excel functionality to improve performance.
	Application.ScreenUpdating = False
	Application.DisplayStatusBar = False
	Application.Calculation = xlCalculationManual
	Application.EnableEvents = False
	' Note: this is a sheet-level setting.
	' ActiveSheet.DisplayPageBreaks = False
	s1 = ActiveSheet.Range("A20000").End(xlUp).Row
	a = ""
	For i = 2 To s1 Step 1
	line_A:
	If a = "" Then
	a = Mid(ActiveSheet.Range(MONTHLY & i), 1, InStrRev(ActiveSheet.Range(MONTHLY & i), "/") - 1)
	Total = ActiveSheet.Range(DATA & i)
	total_count = 1
	a_row = i
	Else
	If InStr(ActiveSheet.Range(MONTHLY & i), a) > 0 Then
	Total = Total + ActiveSheet.Range(DATA & i)
	total_count = total_count + 1
	Else
	ActiveSheet.Range(WRITTEN1 & a_row).NumberFormatLocal = "@"
	ActiveSheet.Range(WRITTEN1 & a_row) = a
	ActiveSheet.Range(WRITTEN2 & a_row) = Total / total_count
	a = ""
	GoTo line_A
	End If
	End If
	Next i
	Application.ScreenUpdating = True
	Application.DisplayStatusBar = True
	Application.Calculation = xlCalculationAutomatic
	Application.EnableEvents = True
	End Sub

view raw gistfile1.txt hosted with ❤ by GitHub

 

月均價+期底：

	Sub AVERAGE_BY_MONTHLY_NEW(MONTHLY, DATA, WRITTEN1, WRITTEN2, WRITTEN3, WRITTEN4) '月平均，a是關鍵字 a行是資料b行是資料回寫在c跟d ,期底是 , WRITTEN3, WRITTEN4
	' Turn off Excel functionality to improve performance.
	Application.ScreenUpdating = False
	Application.DisplayStatusBar = False
	Application.Calculation = xlCalculationManual
	Application.EnableEvents = False
	' Note: this is a sheet-level setting.
	' ActiveSheet.DisplayPageBreaks = False
	s1 = ActiveSheet.Range("A20000").End(xlUp).Row
	a = ""
	For i = 2 To s1 Step 1
	line_A:
	If a = "" Then
	a = Mid(ActiveSheet.Range(MONTHLY & i), 1, InStrRev(ActiveSheet.Range(MONTHLY & i), "/") - 1)
	Total = ActiveSheet.Range(DATA & i)
	Total_END = Total
	total_count = 1
	a_row = i
	Else
	If InStr(ActiveSheet.Range(MONTHLY & i), a) > 0 Then
	Total = Total + ActiveSheet.Range(DATA & i)
	total_count = total_count + 1
	Else
	ActiveSheet.Range(WRITTEN1 & a_row).NumberFormatLocal = "@"
	ActiveSheet.Range(WRITTEN1 & a_row) = a
	ActiveSheet.Range(WRITTEN2 & a_row) = Total / total_count
	ActiveSheet.Range(WRITTEN3 & a_row).NumberFormatLocal = "@"
	ActiveSheet.Range(WRITTEN3 & a_row) = ActiveSheet.Range(MONTHLY & a_row)
	ActiveSheet.Range(WRITTEN4 & a_row) = Total_END
	a = ""
	GoTo line_A
	End If
	End If
	Next i
	Application.ScreenUpdating = True
	Application.DisplayStatusBar = True
	Application.Calculation = xlCalculationAutomatic
	Application.EnableEvents = True
	End Sub

view raw 月均價_期底.vba hosted with ❤ by GitHub

大致上流程：

圖1.VBA CODE流程

要設定4個引數。

例如：日期在A行，資料在B行，然後想要將資料寫在C與D行。

1.先做一個ACTIVEX命令按鈕出來

圖1.命令按鈕在那?

圖3.

2.在VBA編輯視窗上，設定好按鈕事件後，再打上

月均價+期底：

CALL AVERAGE_BY_MONTHLY_NEW("A", "B","C","D","e","f") 即可。

圖4.

執行完長這樣，在自己透過排序整理摟，如圖4.

圖5.

圖6.最近整理的某金屬與個股收盤價(月均價)

圖7.最近整理的某金屬與個股收盤價(期底)

Palladium Prices - Interactive Historical Chart