Board logo

標題: [發問] ELSEIF與DO WHILE巢狀迴圈來判斷加總 [打印本頁]
作者: wiemanson    時間: 2014-4-14 21:26     標題: ELSEIF與DO WHILE巢狀迴圈來判斷加總

[attach]18012[/attach]

這程式主要是想要讓IF來判斷顏色之後，然後來加總所對應的重量。

我的迴圈是當欄位(2,1)不是空格，便會開始執行迴圈，
然後用IF判斷如果顏色為"紅"跟"紅紅"，將會累加重量至欄位(3,5)的紅色
如果顏色是"綠"或是備註有"大"就會累加至欄位(3,6)的綠色
如果顏色是"藍"就會累加至欄位(3,7)的藍色
如果顏色是"黃"就會累加至欄位(3,8)的黃色
如果新舊的欄位有"新"則會累加至欄位(3,9)所有顏色的重量

經過我寫的語法執行後發現，只要某一列的條件有符合，其數值有被累加過之後，我後面寫的另一條件即使符合，居然就無法在往上累加了。


我的語法如下所示：

Sub aa()

Dim x, sum1, sum2, sum3, sum4, sum5, sum6 As Long

x = 2

sum1 = 0
sum2 = 0
sum3 = 0
sum4 = 0
sum5 = 0







Do While Cells(x, 1) <> ""


   
  If Cells(x, 4) = "新" Then
  
  sum5 = sum5 + Cells(x, 2).Value


  ElseIf Cells(x, 1) = "紅" Then

  sum1 = sum1 + Cells(x, 2).Value
   
  ElseIf Cells(x, 1) = "紅紅" Then
  
  sum1 = sum1 + Cells(x, 2).Value
  
  
  ElseIf Cells(x, 1) = "綠" Then

  sum2 = sum2 + Cells(x, 2).Value
   
  ElseIf Cells(x, 3) = "大" Then
  
  sum2 = sum2 + Cells(x, 2).Value
  
  
  
  ElseIf Cells(x, 3) = "藍" Then
  
  sum3 = sum3 + Cells(x, 2).Value
  
  
  ElseIf Cells(x, 3) = "黃" Then
  
  sum4 = sum4 + Cells(x, 2).Value
  
  

  



  

  
  
  
  Else
  sum1 = sum1 + 0
  sum2 = sum2 + 0
  sum3 = sum3 + 0
  sum4 = sum4 + 0
  sum5 = sum5 + 0


  
  
  
  End If
  
  x = x + 1
  
Loop
  
  Cells(3, 5) = sum1
  Cells(3, 6) = sum2
  Cells(3, 7) = sum3
  Cells(3, 8) = sum4
  Cells(3, 9) = sum5









End Sub



經過執行之後，他只會執行累加所有顏色重量的程式，後面的語法就會完全無效。

煩請各位大大解答，感恩的心~~謝謝
作者: GBKEE    時間: 2014-4-15 07:59

回復 1# wiemanson
  1. Option Explicit
  2. Sub Ex()
  3.     Dim x As Integer, S As Variant, AR(), AC()
  4.     With ActiveSheet
  5.         AC = Array("紅", "綠", "藍", "黃")              '顏色陣列: 指定顏色(0-3),顏色可再增加(0-?)
  6.         AR = Array("E3", "F3", "G3", "H3", "I3")  '顏色位置陣列 (紅,綠,藍,黃,總重量): 儲存格的位置(0-4)
  7.         '總重量位置 :UBound(AR) -> 顏色位置陣列的索引值
  8.         .Range(AR(0) & ":" & AR(UBound(AR))) = ""
  9.         x = 2
  10.         Do While .Cells(x, 1) <> ""
  11.             If .Cells(x, 4) = "新" Then
  12.                 S = UBound(AR)                          '
  13.                 .Range(AR(S)) = .Range(AR(S)) + Cells(x, 2)
  14.             Else
  15.                 S = Mid(.Cells(x, 1), 1, 1)             '如紅紅時可讀取"紅"
  16.                 If .Cells(x, 3) = "大" Then S = "綠"
  17.                 S = Application.Match(S, AC, 0)         'Match 如找不到:傳回錯誤值
  18.                 If IsNumeric(S) Then                    'S: 在指定顏色陣列中的位置
  19.                     .Range(AR(S - 1)) = .Range(AR(S - 1)) + .Cells(x, 2)
  20.                 End If
  21.             End If
  22.             x = x + 1
  23.         Loop
  24.         S = UBound(AR)
  25.         .Range(AR(S)) = .Range(AR(S)) + Application.Sum(.Range(AR(0) & ":" & AR(S - 1)))
  26.     End With
  27. End Sub
複製代碼
  1. Sub aa()
  2.     Dim x As Integer, sum1 As Long, sum2 As Long, sum3 As Long, sum4 As Long, sum5 As Long, sum6 As Long
  3.     x = 2
  4.     sum1 = 0
  5.     sum2 = 0
  6.     sum3 = 0
  7.     sum4 = 0
  8.     sum5 = 0
  9.     Do While Cells(x, 1) <> ""
  10.         If Cells(x, 4) = "新" Then
  11.             sum5 = sum5 + Cells(x, 2).Value
  12.         ElseIf Cells(x, 1) = "紅" Then
  13.             sum1 = sum1 + Cells(x, 2).Value
  14.         ElseIf Cells(x, 1) = "紅紅" Then
  15.             sum1 = sum1 + Cells(x, 2).Value
  16.         ElseIf Cells(x, 1) = "綠" Or Cells(x, 3) = "大" Then
  17.             sum2 = sum2 + Cells(x, 2).Value
  18.         ElseIf Cells(x, 1) = "藍" Then   'Cells(x, 3) !!!
  19.             sum3 = sum3 + Cells(x, 2).Value
  20.         ElseIf Cells(x, 1) = "黃" Then 'Cells(x, 3) !!!
  21.             sum4 = sum4 + Cells(x, 2).Value
  22.         End If
  23.         x = x + 1
  24.     Loop
  25.     Cells(3, 5) = sum1
  26.     Cells(3, 6) = sum2
  27.     Cells(3, 7) = sum3
  28.     Cells(3, 8) = sum4
  29.     Cells(3, 9) = sum5 + sum1 + sum2 + sum3 + sum4
  30. End Sub
複製代碼
作者: yen956    時間: 2014-4-15 09:46

本帖最後由 yen956 於 2014-4-15 09:57 編輯

回復 1# wiemanson
不知道你的意思是不是這樣?
執行結果:
紅        綠        藍        黃        All
3        5        1        5        10
如果是, 試試看:
Sub aa()
Dim x, sum1, sum2, sum3, sum4, sum5, sum6 As Long
x = 2
sum1 = 0
sum2 = 0
sum3 = 0
sum4 = 0
sum5 = 0
Do While Cells(x, 1) <> ""
    'If .. Else 具排他, 執行了 Cells(x, 4) = "新", 就不會執行其他的
    If Cells(x, 4) = "新" Then
    sum5 = sum5 + Cells(x, 2).Value
    End If
    '同樣 Cells(x, 3) = "大", 也不能在 IF...Else 內
    If Cells(x, 3) = "大" Then
    sum2 = sum2 + Cells(x, 2).Value
    End If
   
    If Cells(x, 1) = "紅" Then
    sum1 = sum1 + Cells(x, 2).Value
    ElseIf Cells(x, 1) = "紅紅" Then
    sum1 = sum1 + Cells(x, 2).Value
    ElseIf Cells(x, 1) = "綠" Then
    sum2 = sum2 + Cells(x, 2).Value
    ElseIf Cells(x, 1) = "藍" Then
    sum3 = sum3 + Cells(x, 2).Value
    ElseIf Cells(x, 1) = "黃" Then
    sum4 = sum4 + Cells(x, 2).Value
    Else
'沒作用吧?
    sum1 = sum1 + 0
    sum2 = sum2 + 0
    sum3 = sum3 + 0
    sum4 = sum4 + 0
    sum5 = sum5 + 0
    End If
    x = x + 1
Loop
Cells(3, 5) = sum1
Cells(3, 6) = sum2
Cells(3, 7) = sum3
Cells(3, 8) = sum4
Cells(3, 9) = sum5
End Sub
'但不知 "綠","大" 同排時, 你想怎麼處理?
又, sum1, sum2, sum3, sum4, sum5, sum6 一整排變數,
可直接用 [E3], [F3],[G3],... 代替.
試試看:
  1. Private Sub CommandButton1_Click()
  2.     Dim x As Integer
  3.     x = 2
  4.     Range("E3:I3") = 0
  5.     Do While Cells(x, 1) <> ""
  6.         If Cells(x, 4) = "新" Then
  7.             [I3] = [I3] + Cells(x, 2).Value
  8.         End If
  9.         If Cells(x, 3) = "大" Then
  10.             [F3] = [F3] + Cells(x, 2).Value
  11.         End If
  12.         If Cells(x, 1) = "紅" Or Cells(x, 1) = "紅紅" Then
  13.             [E3] = [E3] + Cells(x, 2).Value
  14.         ElseIf Cells(x, 1) = "綠" Then
  15.             [F3] = [F3] + Cells(x, 2).Value
  16.         ElseIf Cells(x, 1) = "藍" Then
  17.             [G3] = [G3] + Cells(x, 2).Value
  18.         ElseIf Cells(x, 1) = "黃" Then
  19.             [H3] = [H3] + Cells(x, 2).Value
  20.         End If
  21.         x = x + 1
  22.     Loop
  23. End Sub
複製代碼
作者: wiemanson    時間: 2014-4-17 01:28

謝謝各位大師的解答，除了解決問題之外，我還學到了很多，真的非常感謝。



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