Excel Vba 如何整理股權分散表(集保庫存) 三、依照檔案別整理個股股權分散表(集保庫存)

 個股集保整理，要用到FileDialog開啟檔案、進階篩選、迴圈、WORKBOOKS物件等等。

小編以非自動下載集保庫存資料為例。

1.首先以FileDialog開啟檔案作下載資料載入。

2.建立檔案清單，根據檔案清單作進階篩選。

3.篩選出的資料建立個股集保資料。

VBA:

1.作兩個ACTIVEX 命令按鈕，順便在A行維護個股代號。WJ6

​

圖1.按鈕與清單建立

先維護第一個ACTIVEX 命令按鈕，作為載入集保庫存檔案用。

VBA：

	Private Sub CommandButton1_Click()
	Dim FILE_OPEN As FileDialog '宣告FILE_OPEN為檔案對話框
	Set FILE_OPEN = Excel.Application.FileDialog(msoFileDialogFilePicker)
	'設定FILE_OPEN為選取檔案功能
	FILE_OPEN.InitialFileName = Excel.ActiveWorkbook.Path '對話框開始目錄的設定
	FILE_OPEN.Filters.Add "Excel File", "*.CSV" '設定對話框要顯示的副檔名
	FILE_OPEN.Filters.Add "所有檔案", "*.*"
	FILE_OPEN.Show '顯示對話框
	For I = 1 To FILE_OPEN.SelectedItems.Count
	Source = Excel.ActiveWorkbook.Name '儲存目前作業中檔案名稱
	FILE_OPEN_PATH = FILE_OPEN.SelectedItems(I) '取的檔案路徑
	Workbooks.Open Filename:=FILE_OPEN_PATH '開啟案路徑
	WORKNAME = Excel.ActiveWorkbook.Name '儲存新開檔案的檔案名稱
	Windows(WORKNAME).Activate '啟用新開檔案的檔案名稱
	A = ActiveSheet.Range("A:F") '複製集保資料
	Windows(Source).Activate
	Sheets("集保戶股權分散表").Activate
	Sheets("集保戶股權分散表").Cells.Clear '集保戶股權分散表全部清除
	Sheets("集保戶股權分散表").Range("A:F") = A '寫入集保資料
	Windows(WORKNAME).Close '關閉集保檔案
	Windows(Source).Activate
	Sheets("工作表1").Activate
	Next I
	End Sub

view raw 載入集保庫存.VBA hosted with ❤ by GitHub

2.第二個ACTIVEX 命令按鈕 VBA:

	Private Sub CommandButton1_Click()
	'標題
	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) <> "" '迴圈判斷A儲存格有無資料
	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 進階篩選個股 '可以自己錄製或是參考 Excel Vba 如何整理集保庫存 一、進階篩選個股
	COUNT_集保 = Application.CountA(Sheets("集保戶股權分散表").Range("M1:M100"))
	A = Sheets("集保戶股權分散表").Range("M2:O" & COUNT_集保) '集保篩選的資料
	K = Sheets("集保戶股權分散表").Range("K2") '取得資料日期
	I = I + 1 'I是控制取得Sheets("工作表1").Range("A" & I)儲存格資料的步進值
	Sheets("集保戶股權分散表").Range("K:P").Clear '清除前回執行結果
	'寫入資料並存檔
	COUNT_寫入 = Application.CountA(Sheets("工作表3").Range("A1:A1000")) '計算資料行數
	Sheets("工作表3").Range("A2") = K '寫入日期
	X1 = 1 'X1控制第一組資料寫入的位置變數
	X2 = 2 'X2'控制第二組資料寫入的位置變數
	'透過一個迴圈寫入2筆資料到儲存格中
	For X3 = LBound(A) To UBound(A) - 2 Step 1 'X3負責控制陣列位置
	Sheets("工作表3").Cells(2, X1 + COUNT_寫入) = A(X3, 2) '寫入A陣列位置2的資料
	Sheets("工作表3").Cells(2, X2 + COUNT_寫入) = A(X3, 3) '寫入A陣列位置3的資料
	X1 = X1 + 2 '步進值遞增
	X2 = X2 + 2 '步進值遞增
	Next X3
	Sheets("工作表3").Copy '複製工作表3 作存檔用
	WORKNAME = Excel.ActiveWorkbook.Name '取的目前使用中工作簿名稱
	Workbooks(WORKNAME).Activate
	ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & STOCK_ID & ".xls", FileFormat:=56 '另存新檔
	WORKNAME = Excel.ActiveWorkbook.Name '取的目前使用中工作簿名稱(存檔後檔名不同)
	Workbooks(WORKNAME).Close
	Workbooks(Source).Activate
	Loop
	End Sub

view raw gistfile1.txt hosted with ❤ by GitHub

            

​

圖2.整理完的個股集保資料

​

圖3.初次建立的檔案

下一篇：依照檔案別維護個股集保庫存