麻辣家族討論版版 - Powered by Discuz! Board

標題: Function() 一直搞不懂 [打印本頁]

作者: Andy2483 時間: 2022-9-22 11:04 標題: Function() 一直搞不懂

本帖最後由 Andy2483 於 2022-9-22 11:09 編輯

各位前輩好
後輩發表的學習主題(連結如下)想改用Function 呼叫字典裡的欄位遇到瓶頸
http://forum.twbts.com/thread-23764-1-1.html

問題:
下列鏈結主題裡的範例簡化程式碼,為什麼會堆疊空間不足的問題?

Option Explicit
Dim V
Function S(x)
Set V = CreateObject("Scripting.Dictionary")
V("操_NO欄") = 1
V("操_記錄日期欄") = 2
V("操_記錄時間欄") = 3
V("操_IN_OUT欄") = 4
V("操_備用欄") = 5
V("操_電話欄") = 6
V("操_飼主欄") = 7
V("操_寵物別欄") = 8
V("操_寵物名欄") = 9
V("操_生日欄") = 10
V("操_年齡欄") = 11
V("操_註記1欄") = 12
V("操_註記2欄") = 13
V("操_註記3欄") = 14
V("操_註記4欄") = 15
S(x) = V(x)
End Function
Sub TEST_20220922_1()
MsgBox S("操_NO欄")
End Sub

複製代碼

原由1:
後學是學習以下這程式碼可以呼叫成功

Function f(x)
f = 2 * x ^ 4 - 4 * x ^ 3 - 3 * x ^ 2 + 7 * x - 2
End Function
Sub TEST_20220922_2()
MsgBox f(0)
End Sub

複製代碼

http://forum.twbts.com/viewthread.php?tid=23428&from=favorites
原由2:
後學目前只會用以下的方式

Option Explicit
Dim V
Sub S2()
Set V = CreateObject("Scripting.Dictionary")
V("操_NO欄") = 1
V("操_記錄日期欄") = 2
V("操_記錄時間欄") = 3
V("操_IN_OUT欄") = 4
V("操_備用欄") = 5
V("操_電話欄") = 6
V("操_飼主欄") = 7
V("操_寵物別欄") = 8
V("操_寵物名欄") = 9
V("操_生日欄") = 10
V("操_年齡欄") = 11
V("操_註記1欄") = 12
V("操_註記2欄") = 13
V("操_註記3欄") = 14
V("操_註記4欄") = 15
End Sub
Sub TEST_20220922_S2()
Call S2
MsgBox V("操_NO欄")
End Sub

複製代碼

謝謝各位前輩指導

作者: Andy2483 時間: 2022-9-22 13:08

找到自己的錯誤了:
S(x) = V(x)是錯誤的!
S = V(x)就能執行了!
謝謝論壇! 謝謝各位前輩!

作者: Andy2483 時間: 2022-9-22 15:36

本帖最後由 Andy2483 於 2022-9-22 15:40 編輯

今天習得:不必要重複呼叫Function 值
Function()雖然可以呼叫到需要的值
但是運用這些值時需要另用容器裝,不然在迴圈裡一直重複呼叫這些值,會多出很多時間

這是原始程式碼,重複呼叫!執行時間很長
Private Sub TextBox1_Change()
Dim Arr, x
List7.Clear
List7.Locked = True
Le = Len(TextBox1.Text)
If Le < 3 Then
Exit Sub
End If
Set xDic = CreateObject("Scripting.Dictionary")
Dim NM
For i = 1 To UBound(Szrr)
If InStr(Szrr(i, f("操_電話欄")), TextBox1.Text) Then
NM = Szrr(i, f("操_電話欄"))
xDic(NM) = ""
End If
Next
If xDic.Count > 1 Then
NM = ""
End If
mNo = 7
For i = 1 To xDic.Count
List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
Next
If xDic.Count > 1 Then
Arr = Application.Transpose(xDic.keys)
End If
Set xDic = Nothing
With List(mNo)
.Locked = False
If .ListCount = 1 Then
.SetFocus
.ListIndex = 0
End If
End With
List1.Clear
List1.Locked = True
mNo = 1
Set xDic = CreateObject("Scripting.Dictionary")
If NM = "" Then
For i = 1 To UBound(Szrr)
For x = 1 To UBound(Arr)
If Szrr(i, f("操_電話欄")) = Arr(x, 1) Then
xDic(Szrr(i, f("操_飼主欄"))) = ""
End If
Next
Next
Else
For i = 1 To UBound(Szrr)
If Szrr(i, f("操_電話欄")) = NM Then
xDic(Szrr(i, f("操_飼主欄"))) = ""
End If
Next
End If
For i = 1 To xDic.Count
List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
Next
Set xDic = Nothing
With List(mNo)
.Locked = False
If .ListCount = 1 Then .SetFocus: .ListIndex = 0
End With
End Sub

複製代碼

這是用J,k盛裝呼叫值,只呼叫一次,時間大幅縮短
Private Sub TextBox1_Change()
Dim Arr, x, j, k
j = f("操_電話欄")
k = f("操_飼主欄")
List7.Clear
List7.Locked = True
Le = Len(TextBox1.Text)
If Le < 3 Then
Exit Sub
End If
Set xDic = CreateObject("Scripting.Dictionary")
Dim NM
For i = 1 To UBound(Szrr)
If InStr(Szrr(i, j), TextBox1.Text) Then
NM = Szrr(i, j)
xDic(NM) = ""
End If
Next
If xDic.Count > 1 Then
NM = ""
End If
mNo = 7
For i = 1 To xDic.Count
List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
Next
If xDic.Count > 1 Then
Arr = Application.Transpose(xDic.keys)
End If
Set xDic = Nothing
With List(mNo)
.Locked = False
If .ListCount = 1 Then
.SetFocus
.ListIndex = 0
End If
End With
List1.Clear
List1.Locked = True
mNo = 1
Set xDic = CreateObject("Scripting.Dictionary")
If NM = "" Then
For i = 1 To UBound(Szrr)
For x = 1 To UBound(Arr)
If Szrr(i, j) = Arr(x, 1) Then
xDic(Szrr(i, k)) = ""
End If
Next
Next
Else
For i = 1 To UBound(Szrr)
If Szrr(i, j) = NM Then
xDic(Szrr(i, k)) = ""
End If
Next
End If
For i = 1 To xDic.Count
List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
Next
Set xDic = Nothing
With List(mNo)
.Locked = False
If .ListCount = 1 Then .SetFocus: .ListIndex = 0
End With
End Sub

複製代碼

作者: Andy2483 時間: 2022-9-22 15:58

改為Call 副程式(Public宣告)取得值,改Function()呼叫值很麻煩
後學心裡浮出一個疑問
用Function() 感覺非常厲害
Function()有什麼特別好用之處是無法取代的嗎?
後學駑鈍! 請各位前輩提示一下!
否則再學十年也無法參透!!

作者: Andy2483 時間: 2022-9-23 11:02

改為Call 副程式(Public宣告)取得值,改Function()呼叫值很麻煩
後學心裡浮出一個疑問
用Function() 感覺非 ...
Andy2483 發表於 2022-9-22 15:58

謝謝論壇各位前輩分享這麼多帖子
Function()與Call 副程式很無辜
1.後學心裡浮出的疑問歸咎是自己學得太少,不懂變通,沒原則!
2.閱覽前輩們的帖子發現,時間效率才是重點
3.為了偵測使用者有沒有變動欄位,每次都 Function回傳正確欄位,浪費時間
4.應該要改原則:使用者變動欄位程式就不能用
5.而程式設計者也要預留變動欄位時,複雜的程式碼該如何用最短時間因應
6.Public Const (宣告為共用的固定變數)是目前後學想到的方法

Public Const 操_NO欄 As Integer = 1
Public Const 操_記錄日期欄 As Integer = 2
Public Const 操_記錄時間欄 As Integer = 3
Public Const 操_IN_OUT欄 As Integer = 4
Public Const 操_備用欄 As Integer = 5
Public Const 操_電話欄 As Integer = 6
Public Const 操_飼主欄 As Integer = 7
Public Const 操_寵物別欄 As Integer = 8
Public Const 操_寵物名欄 As Integer = 9
Public Const 操_生日欄 As Integer = 10
Public Const 操_年齡欄 As Integer = 11
Public Const 操_註記1欄 As Integer = 12
Public Const 操_註記2欄 As Integer = 13
Public Const 操_註記3欄 As Integer = 14
Public Const 操_註記4欄 As Integer = 15
Sub TEST_20220923_1()
MsgBox 操_NO欄
End Sub

複製代碼

7.程式設計者的因應辦法是最快時間產生正確的固定變數宣告,取代掉舊的固定變數宣告

Option Explicit
Sub 自動產生宣告為固定值()
Dim i&, x&, 輔助表標題欄rr, 輔助表變數欄rr, Coderr, 列數&, Y, 操_標題rr
Set Y = CreateObject("Scripting.Dictionary")
With Sheets("Code生成輔助表")
輔助表標題欄rr = .Range(.[AA2], .Cells(Rows.Count, "AA").End(3))
輔助表變數欄rr = .Range(.[AB2], .Cells(Rows.Count, "AB").End(3))
End With
ReDim Coderr(1 To UBound(輔助表標題欄rr) * 5, 1 To 1)
Call 操作表RC判定
With Sheets("操作表")
操_標題rr = .Range(.[A13], .Cells(13, C))
For x = 1 To C
If Trim(操_標題rr(1, x)) = "" Then
MsgBox "不允許有空欄!"
Exit Sub
End If
Y(操_標題rr(1, x)) = x
Next
End With
For i = 1 To UBound(輔助表標題欄rr)
列數 = 列數 + 1
Coderr(列數, 1) = "Public Const 操_" & 輔助表變數欄rr(i, 1) & "欄 As Integer = " & Y(輔助表標題欄rr(i, 1))
1238
Next
Workbooks.Add
[A1].Resize(UBound(Coderr), UBound(Coderr, 2)) = Coderr
Set Coderr = Nothing
MsgBox "將活頁簿的程式碼複製到辨識欄位標題M的Module 裡蓋掉原來程式碼!"
End Sub

複製代碼

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)