Board logo

標題: [發問] VBA loop and select case問題 (HELP) [打印本頁]
作者: hildaliu    時間: 2014-11-7 07:09     標題: VBA loop and select case問題 (HELP)

表格(OrderForm)資料會自動轉移到OrderData sheet
在表格中的Case type 是drop down list 有Red, White,Mixed
請問一下如何令Quantity根據前面的Case type 轉移到OrderData sheet
因為表格資料現在只會順序地轉移到工作表
如果case type 裏的選項不同了，那不會match 工作表中的redno, white no, mixed no 的數目
可能我的表達不清楚，但請高手幫忙
這份excel是大學的assignment

[attach]19502[/attach]
[attach]19503[/attach]

[attach]19504[/attach]
  1. Sub TransferDetails()
  2. '
  3. ' TransferDetails Macro
  4. ' This Macro will make a record of the current details in the order form.
  5. '
  6. ' Keyboard Shortcut: Ctrl+Shift+T
  7. '
  8.    
  9.    

  11.     Sheets("OrderData").Select
  12.    
  13. 'This IF statement will determine whether or not there is a value in the first row of the database and will paste the data accordingly
  14.    
  15.     If IsEmpty(ActiveSheet.Range("A2")) Then
  16.    
  17.     Range("A2").Select
  18.    
  19.     Else
  20.    
  21.     Sheets("OrderForm").Select
  22.     Sheets("OrderData").Select
  23.     Range("A1").Select
  24.     Selection.End(xlDown).Select
  25.     ActiveCell.Offset(1, 0).Range("A1").Select
  26.    
  27.     End If
  28.    
  29.     Sheets("OrderForm").Select
  30.         Range("D14").Select
  31.             Selection.Copy
  32.         Sheets("OrderData").Select
  33.             Selection.PasteSpecial Paste:=xlPasteValues
  34.             ActiveCell.Offset(0, 1).Range("A1").Select
  35.             
  36. ' Forloop starts here

  38. Sheets("OrderForm").Select
  39.    
  40. Dim Winetype As Integer
  41. Dim RWM As String


  44. RWM = ("RWM")

  46.     For Winetype = 1 To 3

  48. ' LOOP ONE

  50. ' This section places the Wine Type Into the RWM Cell for referencing
  51. ' 2.1
  52.     '2.1.1
  53.    
  54.         Sheets("OrderForm").Select
  55.    
  56.     ' 2.1.2
  57.    
  58.         '2.1.2.1
  59.             Range("C17").Select ' <--- C17 = Base Cell
  60.         
  61.         '2.1.2.2
  62.             ActiveCell.Offset(0, 0).Range("A1").Select ' <--- No Change Due to First Iteration
  63.         
  64.     '2.1.3

  66.         '2.1.3.1
  67.             Selection.Copy

  69.         '2.1.3.2.
  70.             Sheets("Price&GiftInfo").Select
  71.                 Range("RWM").Select
  72.                 Selection.PasteSpecial Paste:=xlPasteValues
  73. '2.2

  75.     '2.2.1
  76.         Sheets("OrderForm").Select
  77.         
  78.     '2.2.2
  79.         ActiveCell.Offset(0, 2).Select
  80.         
  81.     '2.2.3
  82.         Selection.Copy
  83.         
  84. '2.3

  86.     '2.3.1.
  87.    
  88.         Sheets("OrderData").Select
  89.             ActiveCell.Select ' <---- No current movement as First Iteration
  90.         
  91.     '2.3.2
  92.         Select Case RWM
  93.         
  94.         Case Is = "Red"
  95.             ActiveCell.Offset(0, 0).Select
  96.             
  97.         Case Is = "White"
  98.             ActiveCell.Offset(0, 1).Select
  99.         
  100.         Case Is = "Mixed"
  101.             ActiveCell.Offset(0, 2).Select
  102.             
  103.         End Select
  104.         
  105.     '2.3.3
  106.         Selection.PasteSpecial Paste:=xlPasteValues
  107.         
  108.       Next
  109.       
  110.       For Winetype = 3 To 3
  111.       
  112.       
  113.       
  114.       
  115.       
  116.       
  117. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  118.       
  119. ' LOOP TWO

  121. '2.1
  122.    
  123.     '2.1.1
  124.         Sheets("OrderForm").Select
  125.    
  126.     '2.1.2
  127.    
  128.         '2.1.2.1
  129.             Range("C17").Select
  130.         
  131.         '2.1.2.2
  132.             ActiveCell.Offset(1, 0).Range("A1").Select ' <---- Second iteration = Move one down
  133.         
  134.     '2.1.3

  136.         '2.1.3.1
  137.             Selection.Copy

  139.         '2.1.3.2.
  140.             Sheets("Price&GiftInfo").Select
  141.                 Range("RWM").Select
  142.                 Selection.PasteSpecial Paste:=xlPasteValues
  143.    
  144. '2.2

  146.     '2.2.1
  147.         Sheets("OrderForm").Select
  148.         
  149.     '2.2.2
  150.         ActiveCell.Offset(0, 2).Select
  151.         
  152.     '2.2.3
  153.         Selection.Copy
  154.         
  155. '2.3

  157.     '2.3.1.
  158.         Sheets("OrderData").Select
  159.         
  160.         ActiveCell.Offset(0, 1).Select ' <---- Second Iteration = Move One Across
  161.         
  162.     '2.3.2
  163.         
  164.         Select Case RWM
  165.         
  166.         Case Is = "Red"
  167.             ActiveCell.Offset(0, -1).Select
  168.             
  169.         Case Is = "White"
  170.             ActiveCell.Offset(0, 0).Select
  171.         
  172.         Case Is = "Mixed"
  173.             ActiveCell.Offset(0, 1).Select
  174.             
  175.         End Select
  176.         
  177.     '2.3.3
  178.         Selection.PasteSpecial Paste:=xlPasteValues
  179.         
  180.         
  181.        Next
  182.       
  183.        For Winetype = 3 To 3
  184.       
  185.       
  186.       
  187.       
  188.       
  189. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  190.       
  191. ' LOOP THREE

  193. '2.1
  194.     '2.1.1
  195.         Sheets("OrderForm").Select
  196.    
  197.     '2.1.2
  198.    
  199.         '2.1.2.1
  200.             Range("C17").Select
  201.         
  202.         '2.1.2.2
  203.             ActiveCell.Offset(2, 0).Range("A1").Select ' <---- Third iteration = Move two down
  204.         
  205.     '2.1.3

  207.         '2.1.3.1
  208.             Selection.Copy

  210.         '2.1.3.2.
  211.         
  212.             Sheets("Price&GiftInfo").Select
  213.                 Range("RWM").Select
  214.                 Selection.PasteSpecial Paste:=xlPasteValues
  215.    
  216. '2.2
  217.     '2.2.1
  218.         Sheets("OrderForm").Select
  219.         
  220.     '2.2.2
  221.         ActiveCell.Offset(0, 2).Select
  222.         
  223.     '2.2.3
  224.         Selection.Copy
  225.    
  226.         
  227. '2.3
  228.     '2.3.1.
  229.         Sheets("OrderData").Select
  230.         
  231.         ActiveCell.Offset(0, 1).Select ' <---- Third Iteration = Move Two Across
  232.         
  233.     '2.3.2
  234.         
  235.         Select Case RWM
  236.         
  237.         Case Is = "Red"
  238.             ActiveCell.Offset(0, -2).Select
  239.             
  240.         Case Is = "White"
  241.             ActiveCell.Offset(0, -1).Select
  242.         
  243.         Case Is = "Mixed"
  244.             ActiveCell.Offset(0, 0).Select
  245.             
  246.         End Select
  247.         
  248.     '2.3.3
  249.         Selection.PasteSpecial Paste:=xlPasteValues
  250.         
  251.     Next Winetype
  252.    
  253.    
  254.    
  255.         
  256. ' Forloop ends here
  257. ActiveCell.Offset(0, 1).Select

  259.    
  260.     Sheets("OrderForm").Select
  261.         Range("E23").Select
  262.         Application.CutCopyMode = False
  263.         Selection.Copy
  264.     Sheets("OrderData").Select
  265.         Selection.PasteSpecial Paste:=xlPasteValues
  266.         ActiveCell.Offset(0, 1).Range("A1").Select
  267.    
  268.     Sheets("OrderForm").Select
  269.         Range("E25:F25").Select
  270.         Application.CutCopyMode = False
  271.         Selection.Copy
  272.     Sheets("OrderData").Select
  273.         ActiveCell.Select
  274.         Selection.PasteSpecial Paste:=xlPasteValues
  275.         ActiveCell.Offset(0, 1).Range("A1").Select
  276.    
  277.     Sheets("OrderForm").Select
  278.         Range("F21").Select
  279.         Application.CutCopyMode = False
  280.         Selection.Copy
  281.     Sheets("OrderData").Select
  282.         Selection.PasteSpecial Paste:=xlPasteValues
  283.         ActiveCell.Offset(0, 1).Range("A1").Select
  284.    
  285.     Sheets("OrderForm").Select
  286.         Range("H17").Select
  287.         Application.CutCopyMode = False
  288.         Selection.Copy
  289.     Sheets("OrderData").Select
  290.         Selection.PasteSpecial Paste:=xlPasteValues
  291.         ActiveCell.Offset(0, 1).Range("A1").Select
  292.    
  293.     Sheets("OrderForm").Select
  294.         Range("H19").Select
  295.         Application.CutCopyMode = False
  296.         Selection.Copy
  297.     Sheets("OrderData").Select
  298.         Selection.PasteSpecial Paste:=xlPasteValues
  299.         ActiveCell.Offset(0, 1).Range("A1").Select
  300.    
  301.     Sheets("OrderForm").Select
  302.         Range("H21").Select
  303.         Application.CutCopyMode = False
  304.         Selection.Copy
  305.     Sheets("OrderData").Select
  306.         Selection.PasteSpecial Paste:=xlPasteValues
  307.         ActiveCell.Offset(0, 1).Range("A1").Select
  308.    
  309.     Sheets("OrderForm").Select
  310.         Range("H23").Select
  311.         Application.CutCopyMode = False
  312.         Selection.Copy
  313.     Sheets("OrderData").Select
  314.         Selection.PasteSpecial Paste:=xlPasteValues
  315.         ActiveCell.Offset(0, 1).Range("A1").Select
  316.    
  317.     Sheets("OrderForm").Select
  318.         Range("H25").Select
  319.         Application.CutCopyMode = False
  320.         Selection.Copy
  321.     Sheets("OrderData").Select
  322.         Selection.PasteSpecial Paste:=xlPasteValues
  323.         ActiveCell.Offset(0, 1).Range("A1").Select
  324.    
  325.     Sheets("OrderForm").Select
  326.         Range("H27").Select
  327.         Application.CutCopyMode = False
  328.         Selection.Copy
  329.     Sheets("OrderData").Select
  330.         Selection.PasteSpecial Paste:=xlPasteValues
  331.         ActiveCell.Offset(0, 1).Range("A1").Select
  332.         
  333. ' Updates the ref no.
  334.    
  335.     Sheets("Price&GiftInfo").Select
  336.         Application.CutCopyMode = False
  337.         
  338.     Range("A21").Select
  339.         ActiveCell.FormulaR1C1 = "='OrderData'!R[18]C[-13]+1"
  340.         
  341.     Sheets("OrderForm").Select
  342.         Range("H14").Select
  343.         ActiveCell.FormulaR1C1 = "='OrderData'!R[7]C[-7]+1"
  344.         Selection.Copy
  345.         
  346.     Sheets("OrderData").Select
  347.         Selection.PasteSpecial Paste:=xlPasteValues
  348.     Application.CutCopyMode = False
  349.     Selection.Copy
  350.    
  351.     Sheets("Price&GiftInfo").Select
  352.         Selection.PasteSpecial Paste:=xlPasteValues
  353.         Application.CutCopyMode = False
  354.     Sheets("OrderData").Select
  355.     ActiveCell.Select
  356.    

  358. End Sub
複製代碼
作者: luhpro    時間: 2014-11-9 08:04

回復 1# hildaliu
只針對那3個資料的拷貝
  1.   Dim iI%
  2.   Dim lTRow&
  3.   Dim rTar As Range
  4.   Dim shSou As Worksheet
  5.   
  6.   Set shSou = Sheets("OrderForm")
  7.   With Sheets("OrderData")
  8.     lTRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
  9.     For iI = 17 To 19
  10.       Set rTar = shSou.Cells(iI, 3)
  11.       Select Case rTar
  12.         Case "Red"
  13.           .Cells(lTRow, 2) = rTar.Offset(, 2)
  14.          
  15.         Case "White"
  16.           .Cells(lTRow, 3) = rTar.Offset(, 2)
  17.             
  18.         Case "Mixed"
  19.           .Cells(lTRow, 4) = rTar.Offset(, 2)
  20.       End Select
  21.     Next
  22.   End With
複製代碼
作者: hildaliu    時間: 2014-11-9 10:32

回復 2# luhpro th
Thanks so much!
unfortunately, I just tried to run it out, but it's still not working
可不可explain一下它的運作?
因為我不太明白這code有什麼意思
Sorry for any inconvenient for explain to me!
作者: luhpro    時間: 2014-11-9 21:23

本帖最後由 luhpro 於 2014-11-9 21:52 編輯

回復 3# hildaliu
  Dim iI% ' 定義iI為Integer(整數)變數
  Dim lTRow& ' 定義lTRow為Long(長整數)變數
  Dim rTar As Range ' 定義rTar為儲存格指標
  Dim shSou As Worksheet ' 定義shSou為工作表指標
  
  Set shSou = Sheets("OrderForm") ' 設定指標shSou指向OrderForm工作表
  With Sheets("OrderData") ' 設定系統預設指標 . 的標的, 底下以 . 開頭的物件或變數中, 其 . 代表OrderData工作表,直到 End With 為止, Cells指令用於表示儲存格, 其格式為 Cells(列號,欄號)
    lTRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1 ' 設定lTRow的值等於 .(即OrderData工作表) 中第2(即B)欄的最底下一個有資料儲存格的列號,
                                                                                                ' Cells(Rows.Count, 2)=B欄最末列, .End(xlUp) 往上找第一個有資料的儲存格, .Row 取得其列號
    For iI = 17 To 19 ' 設定 iI(此處用於列號)的初值為17, 接著執行後續指令,遇到Next時,先將iI加1後再返回此行執行,迴圈內指令重複執行直到 iI 大於 To 後面的數字(本例為19),再接續執行Next後的指令
      Set rTar = shSou.Cells(iI, 3) ' 設定rTar=shSou(即OrderForm工作表)的第3(即C)欄第iI列儲存格
      Select Case rTar ' 底下將依據 rTar 的值做分支處理
        Case "Red" ' 當rTar="Red"時執行底下的指令直到 Case 或 End Select
          .Cells(lTRow, 2) = rTar.Offset(, 2)  ' 設定OrderData工作表的  B欄第lTRow列=rTar向右位移兩欄(即OrderForm工作表的E欄第iI列儲存格)
         
        Case "White" ' 當rTar="White"時執行底下的指令...
          .Cells(lTRow, 3) = rTar.Offset(, 2) ' 同上 C欄第lTRow列=...
            
        Case "Mixed" ' 當rTar="Mixed"時執行底下的指令...
          .Cells(lTRow, 4) = rTar.Offset(, 2) ' 同上 D欄第lTRow列=...
      End Select ' 選擇性分支指令結束
    Next ' 繼續執行下一個 For 指令條件判斷, 以決定是否繼續執行迴圈內的指令
  End With ' With 區塊結束,系統預設指標.的標的指向解除,若上層還有.的指向定義,從之.
作者: hildaliu    時間: 2014-11-10 04:20

回復 4# luhpro
Finally,i got it and the code is totally working!
Thanks for your explanation !!
Thanks so much!!!



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