前一篇說明如何整理，這一篇說明怎樣維護股權資料。
這次會多使用到Scripting.FileSystemObject這個物件。
使用這個物件目的在於判斷檔案有無使用。
先回到維護作業這件事，既然說是維護，那就是既有檔案的資料再更新這樣的概念。
整理一下流程：載入股權分散表>開啟個股檔案>開始更新資料>存檔。
流程展開：
1.清除前回工作頁資料>2.載入股權分散表>3.回寫股權分散表到工作頁中>4.根據股號判斷檔案有無>5.有檔案做開啟個股檔案>6.開始更新資料>7.存檔；流程編號4.中，若無檔案則寫入標題與資料後做檔案新建>以股號存檔
有一個前提，就是VBA的EXCEL跟個股在同一個資料夾中歐，才能檢查有無檔案，否則就要指定資料夾
VBA：
這次多一個FUNCTION副程式，這個副程式功能是用來判斷檔案存在與否用的，當檔案存在則回傳1，反之回傳0
FUNCTION 副程式
Function 檢查檔案存在(S) '檔案存在與否副程式判斷
'S表示路徑
Set fs = CreateObject("Scripting.FileSystemObject") '引用Scripting.FileSystemObject 以使用檔案有無判斷的方法
If fs.FileExists(S) Then
檢查檔案存在= 1 '表示存在
Else
檢查檔案存在= 0
End If
End Function
先做一個ACTIVEX 的命令按鈕。
然後維護以下VBA：
'此段VBA內碼具備有檔案存在有無判斷，當不存在檔案時，會執行產生新檔案的內碼。
'5/20更新、增加移除重複資料的功能
'標題
NEW_TAG = Array("DATE", "999", "999股數", "1000", "1000股數", "5000", "5000股數", "10000", "10000股數", "15000", "15000股數", "20000", "20000股數", "30000", "30000股數", "40000", "40000股數", "50000", "50000股數", "100000", "100000股數", "200000", "200000股數", "400000", "400000股數", "600000", "600000股數", "800000", "800000股數", "1000000", "1000001股數")
I = 1
Source = Excel.ActiveWorkbook.Name '儲存目前作業中檔案名稱
Do While Sheets("工作表1").Range("A" & I) <> ""
Sheets("集保戶股權分散表").Range("I1") = "證券代號"
Sheets("集保戶股權分散表").Range("I2") = Sheets("工作表1").Range("A" & I) '每次迴圈執行的股票代號
STOCK_ID = Sheets("工作表1").Range("A" & I)
Sheets("工作表3").Cells.Clear
Sheets("工作表3").Range("A1:AE1") = NEW_TAG
Call 進階篩選個股 '可以自己錄製或是參考
COUNT_集保 = Application.CountA(Sheets("集保戶股權分散表").Range("M1:M100"))
A = Sheets("集保戶股權分散表").Range("M2:O" & COUNT_集保) '集保篩選的資料
K = Sheets("集保戶股權分散表").Range("K2") 'DATE
FILE_PATH = ThisWorkbook.Path & "\" & STOCK_ID & ".xls"
檢查檔案存在_C = 檢查檔案存在(FILE_PATH)
If 檢查檔案存在_C = 1 Then
'存在時開啟檔案寫入資料。
Workbooks.Open Filename:=FILE_PATH
WORKNAME = Excel.ActiveWorkbook.Name
Windows(WORKNAME).Activate
COUNT_寫入 = ActiveSheet.Range("A2000").End(xlUp).Row + 1
ActiveSheet.Range("A" & COUNT_寫入) = K
X1 = 2
X2 = 3
For X3 = LBound(A) To UBound(A) - 2 Step 1
ActiveSheet.Cells(COUNT_寫入, X1) = A(X3, 2)
ActiveSheet.Cells(COUNT_寫入, X2) = A(X3, 3)
X1 = X1 + 2
X2 = X2 + 2
Next X3
COUNT_寫入 = ActiveSheet.Range("A2000").End(xlUp).Row
Dim myRange As Range
Set myRange = ActiveSheet.Range("A1:AE" & COUNT_寫入)
myRange.RemoveDuplicates Columns:=Array(1), Header:=xlYes
COUNT_寫入 = ActiveSheet.Range("A2000").End(xlUp).Row
ActiveSheet.Range("A1:AE" & COUNT_寫入).Sort Key1:=ActiveSheet.Range("A1"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlStroke, DataOption1:=xlSortNormal
Workbooks(WORKNAME).Save
Workbooks(WORKNAME).Close
Else
Sheets("工作表3").Cells.Clear
Sheets("集保戶股權分散表").Range("K:P").Clear '清除前回執行結果
Sheets("工作表3").Range("A1:AE1") = NEW_TAG
COUNT_寫入 = Sheets("工作表3").Range("A2000").End(xlUp).Row + 1
Sheets("工作表3").Range("A" & 2) = K
X1 = 2
X2 = 3
For X3 = LBound(A) To UBound(A) - 2 Step 1
ActiveSheet.Cells(COUNT_寫入, X1) = A(X3, 2)
ActiveSheet.Cells(COUNT_寫入, X2) = A(X3, 3)
X1 = X1 + 2
X2 = X2 + 2
Next X3
Sheets("工作表3").Copy
WORKNAME = Excel.ActiveWorkbook.Name
Workbooks(WORKNAME).Activate
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & STOCK_ID & ".xls", FileFormat:=56
WORKNAME = Excel.ActiveWorkbook.Name
Workbooks(WORKNAME).Close
End If
I = I + 1 'I是控制取得ActiveSheet.Range("H" & I)儲存格資料的步進值
Workbooks(Source).Activate
Loop
圖1.維護示意圖：
功能發想：如果你跟小編一樣，有數量眾多的股權分散表資料，如圖2，那可以思考把"檔案載入"跟"自動維護功能"用SUB互交呼交功能(CALL)連在一起做運用歐。
圖2.集保戶股權分散表資料檔
小編就分享整理資料與更新到這，接下來就是思考如何分析，這每個投資人各有各自的想法小編就不老王賣瓜了，有興趣參考分析可以參考小編 集保庫存 記錄(視覺化)
留言列表
