snare wrote:
是的，讓程式不要跑太...(恕刪)
那請問師傅
這兩個寫法有什麼不同嗎?!
謝謝
個人積分：63分
文章編號：68020766
個人積分：3107分
文章編號：68021055
個人積分：63分
文章編號：68028862
個人積分：63分
文章編號：68050230
個人積分：0分
文章編號：68065547
個人積分：0分
文章編號：68068465
個人積分：3107分
文章編號：68070168
個人積分：3107分
文章編號：68070186
一、加入自訂股票清單功能
二、股票代號改用combobox選擇
三、加入離線資料庫功能(access)
四、加入離線股票代號檢查功能(使用集保股權分散表，可下載到的2557筆股票代號)
五、執行時優先讀取資料庫，沒資料再上線抓，抓完後自動更新資料庫
(文末有簡易sql範例)
自訂股票方式，在“常用股票”工作表中的“A欄”，新增想要的代號
也可以在工作表1，手動輸入，會自動新增到清單內)
如何分辨資料是下載的，還是從access抓出來的，有加一個簡單的記號
只要看序上面那個“*”號，有就代表是access，沒有就是下載的
工表表2
可刪除，只是我用來記錄離線資料庫2，的下載記錄而己
有ok的，代表完整下載
有部份日期無資料的，代表有些日期沒資料
但因為我是用程式自動判斷下載的，所以有一點點的可能是網站問題
不過，我有隨機抽樣檢查一些沒資料的，基本上是真的沒資料
資料庫
為了避免太複雜，設計很簡單
就股票代號、日期、檢查用的股票清單
也預先建立好2557筆股票代號的table
table內的排列方式，就是網站上的排列方式
資料庫一次全部下載功能，保留不公開，有需要請自行改寫程式碼
每筆股票代號(53週)的資料，約10~20秒，以20秒來計算的話，全部下載約14~15小時
只下載一周，2557筆大約10分鐘
當然這是指正常情況下
如果用8個ip，每個3分身，可以縮短很多時間
這是我用的方法，2557筆(53週)全部，40分鐘左右
目前資料庫更新方式，只有點選過日期的股票代號，才會自動寫入access
第2次點選相同資料時，會自動改成從離線資料庫抓取
日期、資料會自動累計，不限一年，也就是說一個月後，資料庫就變成13個月的資料
但是沒點選過的股票、日期，超過一年再點開，是看不到記錄的，因為網站只提供一年
只有點選過的才能看超過一年
'================================================
'如果想從空白excel重新做一個檔案
'前置作業
'工作表1，需建立一個activex 命令按鍵，巨集指定Manually
'建立一個名稱是“常用股票”的工作表
'其它會自動產生，想換名字請自行改寫程式碼
'================================================
'20180414補充，有些裝新版office，執行程式時(328樓沒用到access的舊版，不會有這個問題)
'部份電腦會在這一行Microsoft.ACE.OLEDB.12.0，出現錯誤
'感謝adakahuang這位高手提醒我，現在很多人都用新版office
'為了相容性沒注意到這個有可能發生這個問題
'出現問題請依adakahuang提供的方法，把程式中所有的 12.0 改成 15.0 就可以了
'====以下放在thisworkbook裡================================
'因網頁改版，請到686樓下載新版程式碼
'以下改版前程式碼，保留參考用，無法正常下載
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'注意，預設關閉時，excel會在無任何提示下自動存檔，如果不要請刪掉這3行
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Call Checkdb_GetPath
Call Update_TDCC_day
Call addlistbox
Call Manually
End Sub
'======以下放在模組裡=================================
Public Const DBname As String = "stock.accdb"
'預設檔名stock.accdb
Global Target As String, Stockid As String, Stockname As String, Use_Combo_Changeid As Boolean
Sub Manually()
Dim LastRow As Integer, online1 As Integer, online2 As Integer, Crange As Range, Combo_Select, idtemp As String
If Use_Combo_Changeid = False Then
LastRow = Sheets("常用股票").Range("a1").CurrentRegion.Rows.Count
If LastRow > 1 Then
Set Crange = Sheets("常用股票").Range("a1", Sheets("常用股票").Range("a1").End(xlDown))
Else
Set Crange = Sheets("常用股票").Range("a1")
End If
idtemp = UCase(InputBox("請輸入證券代號"))
If idtemp = "" Then Exit Sub
If CheckStockId(idtemp) = True Then
Stockid = idtemp
Combo_Select = Application.Match(Stockid, Crange, 0)
If IsError(Combo_Select) Then
LastRow = LastRow + 1
Sheets("常用股票").Cells(LastRow, 1) = Stockid
Combo_Select = LastRow - 1
Else
Combo_Select = Combo_Select - 1
End If
Else
MsgBox "股票代號錯誤，請重新輸入", vbOKOnly, "Error"
Exit Sub
End If
Call AddComboData(LastRow, Combo_Select)
End If
Use_Combo_Changeid = False
With Sheets("工作表1")
.Columns("C:N").ClearContents
Call Get_Offline_Data
If .Cells(2, 3) = "*" And .Cells(2, 8) = "*" Then
Debug.Print "all offline"
Call Get_Offline_Stockname
Else
If .Cells(2, 3) = "" Then online1 = 1 Else online1 = 2
If .Cells(2, 8) = "" Then online2 = 2 Else online2 = 1
If online1 = 1 And online2 = 2 Then Debug.Print "all online" Else Debug.Print "1 online + 1 offline"
Call Get_Online_Data(online1, online2) 'save to access
End If
End With
Call TypeSetting
End Sub
Sub Get_Offline_Data()
ttt = Timer
If Stockid = "" Or Stockid = "股票代號" Then Exit Sub
Dim DB As Object, RS As Object, lastday As String, day(1 To 2) As String, k As Integer, Rsql As String
Set GetXml = CreateObject("WinHttp.WinHttpRequest.5.1")
Set DB = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
Application.ScreenUpdating = False
With Sheets("工作表1")
day(1) = .ListBoxes("list_0").List(.ListBoxes("list_0"))
day(2) = .ListBoxes("list_1").List(.ListBoxes("list_1"))
For k = 1 To 2
Rsql = "SELECT 序,持股,人數,股數,比例 from " & Stockid & " WHERE 日期='" & day(k) & "'"
RS.Open Rsql, DB, 3, 3
Debug.Print RS.RecordCount
If RS.RecordCount <> 0 Then
.Cells(2, 3 + ((k - 1) * 5)) = "*"
.Cells(4, 3 + ((k - 1) * 5)).CopyFromRecordset RS
End If
RS.Close
Next k
End With
With Sheets("工作表1")
.Select
.Cells(2, 4) = day(1)
.Cells(2, 9) = day(2)
End With
DB.Close
Set RS = Nothing
Set DB = Nothing
Debug.Print "Get_Offline_Data", Timer - ttt
Application.ScreenUpdating = True
End Sub
Sub Get_Online_Data(online1 As Integer, online2 As Integer) 'save to access
ttt = Timer
If Stockid = "" Or Stockid = "股票代號" Then Exit Sub
Dim HTMLsourcecode As Object, GetXml As Object, day(1 To 2) As String, DB As Object, sql As String, openDB As String, r As Integer, url_a As String, temp() As String, Combo_Select As Integer, Combo_Text As String
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("WinHttp.WinHttpRequest.5.1")
Set DB = CreateObject("ADODB.Connection")
openDB = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
DB.Open openDB
On Error GoTo redownload
Application.ScreenUpdating = False
day(1) = Sheets("工作表1").ListBoxes("list_0").List(Sheets("工作表1").ListBoxes("list_0"))
day(2) = Sheets("工作表1").ListBoxes("list_1").List(Sheets("工作表1").ListBoxes("list_1"))
For k = online1 To online2
r = 0
retry2:
url_a = "scaDates=" & day(k) & "&scaDate=" & day(k) & "&SqlMethod=StockNo&StockNo=" & Stockid & "&radioStockNo=" & Stockid & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & Stockid & "&clkStockName="
With GetXml
.Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send url_a
HTMLsourcecode.body.innerhtml = .responsetext
If InStr(HTMLsourcecode.body.innerhtml, "Your request timed out") > 0 Then
Debug.Print "timeout"
Delaytick (0.05)
r = r + 1
If r > 10 Then
MsgBox "請稍後再試", vbOKOnly, "Error"
Exit Sub
End If
GoTo retry2
End If
'20180828 更新，網頁表格換位置了，(7、8)，改成(6、7)
Stockname = Split(HTMLsourcecode.all.tags("table")(6).Rows(0).innertext, "資料日期")(0)
Set Table = HTMLsourcecode.all.tags("table")(7).Rows
If Table(1).Cells(0).innertext = "無此資料" Then
Delaytick (0.05)
r = r + 1
If r > 10 Then
MsgBox day(k) & "此日期無資料", vbOKOnly, "Error"
If day(1) <> day(2) Then
sql = "INSERT INTO " & Stockid & _
" (日期,序,持股) VALUES " & _
"('" & day(k) & "','" & "1" & "','" & "無此資料" & "')"
DB.Execute sql
End If
GoTo getnextday
End If
GoTo retry2
End If
ReDim temp(1 To Table.Length - 1, Table(2).Cells.Length - 1)
With Sheets("工作表1")
For i = 1 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
temp(i, j) = Table(i).Cells(j).innertext
Next j
If day(1) <> day(2) Then
sql = "INSERT INTO " & Stockid & _
" (日期,序,持股,人數,股數,比例) VALUES " & _
"('" & day(k) & "','" & temp(i, 0) & "','" & temp(i, 1) & "','" & temp(i, 2) & "','" & temp(i, 3) & "','" & temp(i, 4) & "')"
DB.Execute sql
End If
Next i
.Range(.Cells(4, 3 + ((k - 1) * 5)), .Cells(i + 2, 7 + ((k - 1) * 5))) = temp()
End With
End With
getnextday:
Next k
With Sheets("工作表1")
.Select
.Cells(2, 4) = day(1)
.Cells(2, 9) = day(2)
End With
DB.Close
Set DB = Nothing
Set Table = Nothing
Set HTMLsourcecode = Nothing
Set GetXml = Nothing
Application.ScreenUpdating = True
Debug.Print Timer - ttt
Exit Sub
redownload:
r = r + 1
Debug.Print "http 404"
Delaytick (0.05)
If r > 10 Then
MsgBox "連線異常，請稍後再試", vbOKOnly, "Error"
Exit Sub
End If
GoTo retry2
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
Sub TypeSetting()
'想改變字體、欄寬、格式…等等的，全部在這個副程式
Application.ScreenUpdating = False
With Sheets("工作表1")
.Select
.Range("c3:n3") = Array("序", "持股", "人數", "股數", "比例%", "序", "持股", "人數", "股數", "比例%", "人數變化", "張數變化")
'這裡搞錯了，張數變化，要改成股數變化才對，請自行修改
'如果要維持張數變化，請把下面2行的"=RC[-3]-RC[-8]"，改成"=(RC[-3]-RC[-8])/1000"
.Cells(4, 13).FormulaR1C1 = "=RC[-3]-RC[-8]"
.Cells(4, 14).FormulaR1C1 = "=RC[-3]-RC[-8]"
.Range("M4:N4").AutoFill Destination:=Range("M4:N18"), Type:=xlFillDefault
.Range("C3:N25").HorizontalAlignment = xlRight
.Range("D3:D25,I3:I25").HorizontalAlignment = xlLeft
'不想上色的，請刪掉下面這一行
Call SetFormatCondition
.Cells.Font.Size = "10"
.Columns.AutoFit
.Columns("A:B").ColumnWidth = 15
.Columns("M:N").NumberFormatLocal = "#,##0_ "
.Range("c:c,h:h").ColumnWidth = 3
.Range("d:d,i:i").ColumnWidth = 18
.Range("e:e,j:j").ColumnWidth = 10
.Range("f:f,k:k").ColumnWidth = 15
.Range("g:g,l:l").ColumnWidth = 6
.Cells(1, 4) = Stockname ' debug
.Cells(1, 1).Select
End With
Application.ScreenUpdating = True
End Sub
Sub Get_Offline_Stockname()
ttt = Timer
Dim DB As Object, RS As Object
Set DB = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
RS.Open "SELECT 代號,名稱 FROM 股票清單 WHERE 代號='" & Stockid & "'", DB, 3, 3
Stockname = "證券代號：" & RS.Fields(0) & " 證券名稱：" & RS.Fields(1)
RS.Close
DB.Close
Set RS = Nothing
Set DB = Nothing
Debug.Print "get_offline_stockname", Timer - ttt
End Sub
Function CheckStockId(id As String) As Boolean
ttt = Timer
Dim DB As Object, RS As Object
Set DB = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
RS.Open "SELECT 代號,名稱 FROM 股票清單 WHERE 代號='" & UCase(id) & "'", DB, 3, 3
If RS.RecordCount = 0 Then
CheckStockId = False
Debug.Print "無此代號", Timer - ttt
Stockname = ""
Else
CheckStockId = True
Debug.Print "代號正確", Timer - ttt
Stockname = "證券代號：" & RS.Fields(0) & " 證券名稱：" & RS.Fields(1)
End If
RS.Close
DB.Close
Set RS = Nothing
Set DB = Nothing
Debug.Print "checkstockid", Timer - ttt
End Function
Sub SetFormatCondition()
Dim Crange As Range, C1 As FormatCondition, C2 As FormatCondition
Set Crange = Sheets("工作表1").Range("m4", Sheets("工作表1").Range("n4").End(xlDown))
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
Set Crange = Nothing
End Sub
Sub addlistbox()
ttt = Timer
Dim DB As Object, RS As Object, lastday As String, list_0, list_1, Combo_0, temp()
Set DB = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
On Error Resume Next
Sheets("工作表1").Columns("C:N").ClearContents
Application.ScreenUpdating = False
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
RS.Open "select 日期 from 日期清單 order by 日期 desc", DB, 3, 3
temp = RS.getrows
With Sheets("工作表1")
.Select
.Shapes.Range(Array("List_0", "List_1", "Combo_0")).Delete
.Cells.Clear
Set list_0 = .ListBoxes.Add(.Range("a3").Left + 1, .Range("a3").Top, 82, 400)
Set list_1 = .ListBoxes.Add(.Range("b3").Left + 1, .Range("b3").Top, 82, 400)
Set Combo_0 = .Shapes.AddFormControl(xlDropDown, .Range("a1").Left, .Range("a1").Top, 86, 15)
With list_0
.Name = "list_0"
list_0.List = temp()
.Selected(2) = True
.OnAction = "Listbox_Change"
End With
With list_1
.Name = "list_1"
list_1.List = temp()
.Selected(1) = True
.OnAction = "Listbox_Change"
End With
With Combo_0
.Name = "Combo_0"
.ControlFormat.DropDownLines = 10
Sheets("常用股票").Range("a1") = "股票代號"
Call AddComboData(0, 1)
.OnAction = "Combo_0_Change"
End With
If Stockid = "" Then Stockid = .Shapes("combo_0").ControlFormat.List(1)
.Cells.Font.Size = "10"
.Columns.AutoFit
.Columns("A:B").ColumnWidth = 15
.Cells(1, 1).Select
End With
Application.ScreenUpdating = True
Debug.Print "表單物件" & Sheets("工作表1").Shapes.Count, "default stockid=" & Stockid
Erase temp
RS.Close
DB.Close
Set RS = Nothing
Set DB = Nothing
End Sub
Sub Listbox_Change()
Dim LastRow As Integer
LastRow = Sheets("常用股票").Range("a1").CurrentRegion.Rows.Count
If Stockid <> "股票代號" And LastRow > 1 Then
Use_Combo_Changeid = True
Call Manually
End If
End Sub
Sub Combo_0_Change()
Dim Combo_Select As Integer, LastRow As Integer
LastRow = Sheets("常用股票").Range("a1").CurrentRegion.Rows.Count
With Sheets("工作表1")
Combo_Select = .Shapes("combo_0").ControlFormat.Value
Stockid = .Shapes("combo_0").ControlFormat.List(Combo_Select)
Debug.Print Stockid
End With
If Stockid <> "股票代號" And LastRow > 1 Then
Use_Combo_Changeid = True
Call Manually
End If
End Sub
Sub AddComboData(LastRow As Integer, Combo_Select)
Dim Combo_Range As String
If LastRow = 0 Then
LastRow = Sheets("常用股票").Range("a1").CurrentRegion.Rows.Count
Combo_Range = "常用股票!$A$2:$A$" & LastRow
End If
If LastRow = 1 Then
Combo_Range = "常用股票!$A$1:$A$" & LastRow
End If
If LastRow > 1 Then
Combo_Range = "常用股票!$A$2:$A$" & LastRow
End If
With Sheets("工作表1")
.Shapes("combo_0").ControlFormat.ListFillRange = Combo_Range
.Shapes("combo_0").ControlFormat.Value = Combo_Select
End With
End Sub
Sub Update_TDCC_day()
ttt = Timer
Dim GetXml As Object, DB As Object, RS As Object, r As Integer, TDCC_day() As String, a As Integer, d As Integer
Set GetXml = CreateObject("WinHttp.WinHttpRequest.5.1")
Set DB = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
On Error Resume Next
r = 0
retry1:
With GetXml
'20180818 修正網址
.Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", "https://www.tdcc.com.tw/smWeb/QryStock.jsp"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send "REQ_OPR=qrySelScaDates"
If InStr(.responsetext, "Your request timed out") > 0 Or .responsetext = "[]" Then
Debug.Print "timeout"
Delaytick (0.01)
r = r + 1
If r > 10 Then
MsgBox "日期無法更新，請稍後再試", vbOKOnly, "Error"
Exit Sub
End If
GoTo retry1
End If
TDCC_day = Split(Replace(Replace(Replace(.responsetext, "[", ""), "]", ""), """", ""), ",")
For i = 0 To UBound(TDCC_day)
RS.Open "SELECT 日期 FROM 日期清單 WHERE 日期='" & TDCC_day(i) & "'", DB, 3, 3
If RS.RecordCount = 0 Then
'Debug.Print "新增日期", TDCC_day(i), RS.RecordCount
DB.Execute = "INSERT INTO 日期清單 (日期) VALUES ('" & TDCC_day(i) & "')"
a = a + 1
Else
'"日期重覆"
d = d + 1
End If
RS.Close
Next i
End With
DB.Close
Set RS = Nothing
Set DB = Nothing
Set GetXml = Nothing
Debug.Print "Update_TDCC_day", "新增" & a, "重覆" & d, Timer - ttt
End Sub
Sub Checkdb_GetPath()
Target = ThisWorkbook.Path & "\" & DBname
'預設路徑，和工作表相同
If Dir(Target) <> "" Then
Debug.Print "db ready"
Use_Combo_Changeid = True
Else
MsgBox "資料庫不存在，程式結束"
Application.DisplayAlerts = False
Application.Quit
ThisWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End If
End Sub
Sub Delaytick(setdelay As Single)
Dim StartTime As Double, NowTime As Double
StartTime = Timer * 100
setdelay = setdelay * 100
Do
NowTime = Timer * 100
DoEvents
Loop Until NowTime - StartTime > setdelay
End Sub
'================================================
即時運算視窗中也有一些簡單的記錄，有興趣可以打開來看
另外，因為程式中使用了全域變數，如果想要自行改寫
在測試程式時，您只要在不同的模組執行程式，再切回這個模組
Target, Stockid, Stockname , Use_Combo_Changeid
這四個變數，會變空白，原來的程式就無法執行，改寫測試時，請注意
(2018-08-28 修正改版後網址)excel工作表(下載後，請和資料庫放在同一個目錄)
'因網頁改版，請到686樓下載新版程式碼
資料庫選一個下載就可以了，差別在資料量而己
離線資料庫1
已下載 20170407~20180403 宏碁、旺宏，53週全部資料
(單筆股票，每週資料約15~17列，53週約850列，2筆股票合計資料約1,700列)
附加壓縮檔: 201804/mobile01-3fc895e45a8d4fbd6775c02dfd4a784d.zip
離線資料庫2
已下載 20170407~20180403 集保股權分散表，2557筆有效股票代號，53週全部資料
(單筆股票，每週資料約15~17列，53週約850列，2557筆股票合計資料約2,173,450列)
因為容量超過mobile01上傳限制，改用免費空間下載
https://www.sendspace.com/file/b0mqf7
注意：要點download 那個，會先打開一個廣告網頁，再重點一次download
我上傳的是zip檔，不是exe，這種免費空間，有時候會有廣告軟體，不要下錯了
連結也不確定能活多久，擔心的話，請使用離線資料庫1就好
'===============================================================
'access + sql 來分析資料可是很強悍的，在大量資料的整理上，不是excel能比的
'以下是一個簡單的sql語法範例，(需搭配我上傳的資料庫使用)
'有興趣的另外建檔來練習，sql語法，請自行google
Sub test()
Dim DB As Object, RS As Object, lastday As String, Target As String
Set DB = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
Target = ThisWorkbook.Path & "\stock.accdb"
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Target & ";"
'簡單寫5行，有興趣的自己分別跑看看
'1、取出2353 ，日期20180323 的資料
RS.Open "SELECT 序,持股,人數,股數,比例 from 2353 WHERE 日期='" & "20180323" & "'", DB, 3, 3
'2、取出2353 ，分級(序) 15 的資料
'RS.Open "SELECT 序,持股,人數,股數,比例 from 2353 WHERE 序='15'", DB, 3, 3
'3、取出2353 ，日期20180403 + 序=15 的資料
'RS.Open "SELECT 序,持股,人數,股數,比例 from 2353 WHERE 日期='" & "20180403" & "' and 序='15'", DB, 3, 3
'4、取出2353 ，所有 持股在 1,000,001以上的資料
'RS.Open "SELECT * from 2353 WHERE 持股='1,000,001以上'", DB, 3, 3
'5、取出2353 ，所有 持股在 1-999 的日期
'RS.Open "SELECT 日期 from 2353 WHERE 持股='1-999'", DB, 3, 3
Sheets("工作表3").Cells.Clear
Sheets("工作表3").Cells(1, 1).CopyFromRecordset RS
RS.Close
DB.Close
Set RS = Nothing
Set DB = Nothing
End Sub
'============================================
(20180920) 關閉錯誤檢查方式
因為範例中，沒有特別去設定儲存格的類型，再加上每個的人excel設定不一定相同
所以有些人執行時會出現綠色3角型(錯誤檢查)
錯誤檢查對excel效率的影響，可不輸 ScreenUpdating
有能力的可以自己在程式中加入改儲存格格式的程式碼，避免錯誤檢查出現
(參考錄巨集的程式碼就可以了)
或
在範例的開頭如入一行
Application.ErrorCheckingOptions.BackgroundChecking = False
不想改的，請照下面圖片修改
選項=>公式=>格式化為文字…… =>不要打勾
或
選項=>公式=>啟用錯誤檢查 =>不要打勾
個人積分：307分
文章編號：68076592
個人積分：1分
文章編號：68079204
