Board logo

標題: 請問是否有化簡的方法? (再次感謝G大的幫忙~完成 [打印本頁]
作者: av8d    時間: 2012-7-24 15:48     標題: 請問是否有化簡的方法? (再次感謝G大的幫忙~完成

本帖最後由 av8d 於 2012-7-25 18:43 編輯
  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

  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    時間: 2012-7-24 16:06

回復 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    時間: 2012-7-24 18:25

本帖最後由 av8d 於 2012-7-25 00:23 編輯

回復 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    時間: 2012-7-25 16:15

回復 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
複製代碼




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