把686樓的範例,多加上一個產生總表的功能
而這個總表,是參考(抄襲),投資理財區專家Acer_kewei,所整理的表
(參考來源)
https://www.mobile01.com/topicdetail.php?f=291&t=5107288&p=1284
因為是用現有的access資料庫
所以除了新增的總表整理用程式碼、多加了一個按鈕、多了一個工作表2之外,其它幾乎沒改
有變動的地方如下
'typesetting副程式,修正一行
sub TypeSetting()
……
……
Call SetFormatCondition(Sheets("工作表1").Range("m4:n20"))
……
……
end sub
'SetFormatCondition副程式,改了幾行
Sub SetFormatCondition(Crange As Range)
Dim C1 As FormatCondition, C2 As FormatCondition
Crange.FormatConditions.Delete
Crange.Font.Bold = True
Set C1 = Crange.FormatConditions.Add(xlCellValue, xlGreater, "=0")
C1.Font.Color = vbRed
Set C2 = Crange.FormatConditions.Add(xlCellValue, xlLess, "=0")
C2.Font.Color = -11489280
End Sub
'================================================
'以下是這次的主要更新,整理總表用的副程式
'================================================
Sub ListAllStock()
Dim i As Integer
'====for debug ======
'Target = ThisWorkbook.Path & "\" & "stock.accdb"
'====================
Sheets("工作表2").Cells.Clear
Call AddComboData(Sheets("常用股票").Range("a1").CurrentRegion.Rows.Count, 1)
For i = 1 To Sheets("工作表1").Shapes("combo_0").ControlFormat.ListCount
Stockid = Sheets("工作表1").Shapes("combo_0").ControlFormat.List(i)
Use_Combo_Changeid = True
Call Manually
Sheets("工作表2").Range("c2:d17").Offset(0, (i - 1) * 2).Value = Sheets("工作表1").Range("m3:n18").Value
Sheets("工作表2").Range("d19").Offset(0, (i - 1) * 2).Value = Sheets("工作表1").Cells(Sheets("工作表1").Range("j65000").End(xlUp).Row, 10).Value
Sheets("工作表2").Cells(1, (i - 1) * 2 + 3).Value = Split(Stockname, "證券名稱:")(1)
Sheets("工作表2").Cells(1, (i - 1) * 2 + 3).Resize(, 2).Merge
Next i
Sheets("工作表1").Shapes("combo_0").ControlFormat.Value = i - 1
With Sheets("工作表2")
.Range("a2:b17").Value = Sheets("工作表1").Range("c3:d18").Value
.Range("a19") = "股東人數"
.Range("b1") = Sheets("工作表1").ListBoxes("list_0").List(Sheets("工作表1").ListBoxes("list_0")) & vbNewLine & "~" & vbNewLine & Sheets("工作表1").ListBoxes("list_1").List(Sheets("工作表1").ListBoxes("list_1"))
.Cells.Font.Bold = True
.Cells.HorizontalAlignment = xlCenter
.Cells.VerticalAlignment = xlCenter
.Range("c3:d17").Resize(, (i - 1) * 2).NumberFormatLocal = "#,##0_ "
.Columns.AutoFit
End With
Call SetFormatCondition(Sheets("工作表2").Range("c3:d17").Resize(, (i - 1) * 2))
End Sub
使用方式
一、先選好日期
二、按產生總表
三、點選工作表2
總表排列方式,照“常用股票”工作表中的股票代碼順序
常用股票工作表中的清單,請自行複製到新檔
access資料庫 stock.accdb,可延用不需重新下載
[點擊下載]