Function() 一直搞不懂

Andy2483

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

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

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

複製代碼

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

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

複製代碼

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

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

複製代碼

謝謝各位前輩指導

Andy2483

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

Andy2483

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

1. 這是原始程式碼,重複呼叫!執行時間很長
   
2. Private Sub TextBox1_Change()
   
3. Dim Arr, x
   
4. List7.Clear
   
5. List7.Locked = True
   
6. Le = Len(TextBox1.Text)
   
7. If Le < 3 Then
   
8.    Exit Sub
   
9. End If
   
10. Set xDic = CreateObject("Scripting.Dictionary")
    
11. Dim NM
    
12. For i = 1 To UBound(Szrr)
    
13.    If InStr(Szrr(i,  f("操_電話欄")), TextBox1.Text) Then
    
14.       NM = Szrr(i, f("操_電話欄"))
    
15.       xDic(NM) = ""
    
16.    End If
    
17. Next
    
18. If xDic.Count > 1 Then
    
19.    NM = ""
    
20. End If
    
21. mNo = 7
    
22. For i = 1 To xDic.Count
    
23.    List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
    
24. Next
    
25. If xDic.Count > 1 Then
    
26.    Arr = Application.Transpose(xDic.keys)
    
27. End If
    
28. Set xDic = Nothing
    
29. With List(mNo)
    
30.    .Locked = False
    
31.    If .ListCount = 1 Then
    
32.       .SetFocus
    
33.       .ListIndex = 0
    
34.    End If
    
35. End With
    
36. List1.Clear
    
37. List1.Locked = True
    
38. mNo = 1
    
39. Set xDic = CreateObject("Scripting.Dictionary")
    
40. If NM = "" Then
    
41.    For i = 1 To UBound(Szrr)
    
42.       For x = 1 To UBound(Arr)
    
43.          If Szrr(i, f("操_電話欄")) = Arr(x, 1) Then
    
44.             xDic(Szrr(i, f("操_飼主欄"))) = ""
    
45.          End If
    
46.       Next
    
47.    Next
    
48.    Else
    
49.       For i = 1 To UBound(Szrr)
    
50.          If Szrr(i, f("操_電話欄")) = NM Then
    
51.             xDic(Szrr(i, f("操_飼主欄"))) = ""
    
52.          End If
    
53.       Next
    
54. End If
    
55. For i = 1 To xDic.Count
    
56.    List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
    
57. Next
    
58. Set xDic = Nothing
    
59. With List(mNo)
    
60.    .Locked = False
    
61.    If .ListCount = 1 Then .SetFocus: .ListIndex = 0
    
62. End With
    
63. End Sub

複製代碼

1. 這是用J,k盛裝呼叫值,只呼叫一次,時間大幅縮短
   
2. Private Sub TextBox1_Change()
   
3. Dim Arr, x, j, k
   
4. j = f("操_電話欄")
   
5. k = f("操_飼主欄")
   
6. List7.Clear
   
7. List7.Locked = True
   
8. Le = Len(TextBox1.Text)
   
9. If Le < 3 Then
   
10.    Exit Sub
    
11. End If
    
12. Set xDic = CreateObject("Scripting.Dictionary")
    
13. Dim NM
    
14. For i = 1 To UBound(Szrr)
    
15.    If InStr(Szrr(i, j), TextBox1.Text) Then
    
16.       NM = Szrr(i, j)
    
17.       xDic(NM) = ""
    
18.    End If
    
19. Next
    
20. If xDic.Count > 1 Then
    
21.    NM = ""
    
22. End If
    
23. mNo = 7
    
24. For i = 1 To xDic.Count
    
25.    List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
    
26. Next
    
27. If xDic.Count > 1 Then
    
28.    Arr = Application.Transpose(xDic.keys)
    
29. End If
    
30. Set xDic = Nothing
    
31. With List(mNo)
    
32.    .Locked = False
    
33.    If .ListCount = 1 Then
    
34.       .SetFocus
    
35.       .ListIndex = 0
    
36.    End If
    
37. End With
    
38. List1.Clear
    
39. List1.Locked = True
    
40. mNo = 1
    
41. Set xDic = CreateObject("Scripting.Dictionary")
    
42. If NM = "" Then
    
43.    For i = 1 To UBound(Szrr)
    
44.       For x = 1 To UBound(Arr)
    
45.          If Szrr(i, j) = Arr(x, 1) Then
    
46.             xDic(Szrr(i, k)) = ""
    
47.          End If
    
48.       Next
    
49.    Next
    
50.    Else
    
51.       For i = 1 To UBound(Szrr)
    
52.          If Szrr(i, j) = NM Then
    
53.             xDic(Szrr(i, k)) = ""
    
54.          End If
    
55.       Next
    
56. End If
    
57. For i = 1 To xDic.Count
    
58.    List(mNo).AddItem WorksheetFunction.Index(xDic.keys, i)
    
59. Next
    
60. Set xDic = Nothing
    
61. With List(mNo)
    
62.    .Locked = False
    
63.    If .ListCount = 1 Then .SetFocus: .ListIndex = 0
    
64. End With
    
65. End Sub

複製代碼

Andy2483

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

Andy2483

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

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

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

複製代碼

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

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

複製代碼