請問是否有化簡的方法? (再次感謝G大的幫忙~完成

av8d

1. Set d = CreateObject("Scripting.Dictionary")
   
2. d("GAS1") = "A"
   
3. d("GAS2") = "B"
   
4. d("GAS3") = "C"
   
5. d("GAS4") = "D"
   
6. d("GAS5") = "E"
   
7. d("GAS6") = "F"
   
8. d("GAS7") = "G"
   
9. d("GAS8") = "H"
   
10. d("GAS9") = "I"
    
11. d("GAS10") = "J"
    
12. d("GAS11") = "K"
    
13. d("GAS12") = "L"
    
14. d("GAS13") = "M"
    
15. d("GAS14") = "N"
    
16. d("GAS15") = "O"
    
17. d("GAS16") = "P"
    
18. d("GAS17") = "Q"
    
19. d("GAS18") = "R"
    
20. L1C = Label1.Caption
    
21. L2C = Label2.Caption
    
22. L3C = Label3.Caption
    
23. L4C = Label4.Caption
    
24. TB1 = TextBox1.Value
    
25. 
    
26. '資料轉換
    
27. For i = 1 To 18
    
28.     If Me.Controls("OptionButton" & i).Value = True Then
    
29.         If i = 1 Then
    
30.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
31.         End If
    
32.         
    
33.         If i = 2 Then
    
34.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
35.         End If
    
36.         
    
37.         If i = 3 Then
    
38.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
39.         End If
    
40.         
    
41.         If i = 4 Then
    
42.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
43.         End If
    
44.         
    
45.         If i = 5 Then
    
46.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
47.         End If
    
48.         
    
49.         If i = 6 Then
    
50.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
51.         End If
    
52.         
    
53.         If i = 7 Then
    
54.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
55.         End If
    
56.         
    
57.         If i = 8 Then
    
58.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
59.         End If
    
60.         
    
61.         If i = 9 Then
    
62.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
63.         End If
    
64.         
    
65.         If i = 10 Then
    
66.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
67.         End If
    
68.         
    
69.         If i = 11 Then
    
70.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
71.         End If
    
72.         
    
73.         If i = 12 Then
    
74.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
75.         End If
    
76.         
    
77.         If i = 13 Then
    
78.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
79.         End If
    
80.         
    
81.         If i = 14 Then
    
82.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
83.         End If
    
84.         
    
85.         If i = 15 Then
    
86.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
87.         End If
    
88.         
    
89.         If i = 16 Then
    
90.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
91.         End If
    
92.         
    
93.         If i = 17 Then
    
94.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
95.         End If
    
96.         
    
97.         If i = 18 Then
    
98.         Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
99.         End If
    
100.     End If
     
101. Next i

複製代碼

GBKEE

回復 1# av8d

1. Sub Ex()
   
2.     Dim d As Object, i As Integer
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     L1C = Label1.Caption
   
5.     L2C = Label2.Caption
   
6.     L3C = Label3.Caption
   
7.     L4C = Label4.Caption
   
8.     TB1 = TextBox1.Value
   
9.     For i = 1 To 18
   
10.         d("GAS" & i) = Chr(64 + i)   '使用字元
    
11.         If Me.Controls("OptionButton" & i).Value = True Then
    
12.             Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
13.         End If
    
14.     Next
    
15. End Sub

複製代碼

av8d

回復 2# GBKEE


    G大再次打擾~如果是這樣A~R是不規則中文~用英文暫代
d("GAS1") = "A"
d("GAS2") = "B"
d("GAS3") = "C"
d("GAS4") = "D"
d("GAS5") = "E"
d("GAS6") = "F"
d("GAS7") = "G"
d("GAS8") = "H"
d("GAS9") = "I"
d("GAS10") = "J"
d("GAS11") = "K"
d("GAS12") = "L"
d("GAS13") = "M"
d("GAS14") = "N"
d("GAS15") = "O"
d("GAS16") = "P"
d("GAS17") = "Q"
d("GAS18") = "R"
L1C = Label1.Caption
L2C = Label2.Caption
L3C = Label3.Caption
L4C = Label4.Caption
TB1 = TextBox1.Value

'資料轉換
For i = 1 To 18
    If Me.Controls("OptionButton" & i).Value = True Then
        Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    End If
Next i

For i = 19 To 36
    If Me.Controls("OptionButton" & i).Value = True Then
        Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    End If
Next i

d("GAS19")到d("GAS36")和d("GAS1")到d("GAS18")一樣
d("GAS1")等於d("GAS19")
d("GAS2")等於d("GAS20")
以此類推
我該如何寫才不用一直重複寫?

GBKEE

回復 3# av8d

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim d As Object, i As Integer
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     L1C = Label1.Caption
   
6.     L2C = Label2.Caption
   
7.     L3C = Label3.Caption
   
8.     L4C = Label4.Caption
   
9.     TB1 = TextBox1.Value
   
10.     For i = 1 To 18
    
11.         d("GAS" & i) = Sheet1.Cells(i, "A")  '不規則中文在 A1 - A18
    
12.         If Me.Controls("OptionButton" & i).Value = True Then
    
13.             Sheets("點餐").Cells(Rows.Count, "A").End(3)(2, 1).Resize(1, 7) = Array(L1C, L2C, L3C, L4C, 1, d("GAS" & i), TB1)
    
14.         End If
    
15.     Next
    
16. End Sub

複製代碼