12
返回列表 上一主題 發帖

[發問] [求助] VBA 比對後持續相減 問題

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-4-11 20:45 | 只看該作者

[發問] [求助] VBA 比對後持續相減 問題

EXCEL A 頁
有兩名同學 與 每日花費


EXCEL B 頁
兩名同學存款




VB寫法

Sub TEST()

Dim i As Integer
Dim j As Integer

Sheets("A").Select
        
       i = 3
      
    Do While Range("B" & i) <> ""
   
       j = 3
      
    Do While Sheets("B").Range("A" & j) <> ""
        If Range("B" & i) = Sheets("B").Range("A" & j) Then
           Range("D" & i) = Sheets("B").Range("B" & j) - Sheets("A").Range("C" & i)
    Exit Do
         End If
            j = j + 1
  Loop
            i = i + 1
Loop

MsgBox " TEST! "


End Sub
問題點 他只會比對後使用存款相減 當日花費 並不會連續相減
例如 小明 存款 5000 ( 1/30 小明 花費 300 ) ( 存款5000 - 300 = 4700 ) 具續比對 2/13 小明 花費 200 ( 存款 5000 - 200 = 4800 )

請教各位高手
指導一下 希望可以改成
例如 小明 存款 5000 ( 1/30 小明 花費 300 ) ( 存款5000 - 300 = 4700 ) 具續比對 2/13 小明 花費 200 ( 存款 4700 - 200 = 4500 )


懊惱許久，一直無法解決。。。
煩請指導一下 !

3.jpg (36.11 KB)

3.jpg

收藏 分享

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
11#
發表於 2015-4-16 02:59 | 只看該作者
回復  sabery


  下面是我執行的結果
B工作表

A工作表
lpk187 發表於 2015-4-15 20:31


太強了 ...
因為是興趣想自學! 當初學校有教過一點點 .
不知道版大也是嗎? 還是有去上過呢 ?

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
10#
發表於 2015-4-15 20:31 | 只看該作者
回復 8# sabery


  下面是我執行的結果
B工作表
b.png
A工作表

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 2015-4-15 20:25 | 只看該作者
本帖最後由 lpk187 於 2015-4-15 20:26 編輯

回復 8# sabery

程序中條件不同，整體的程序也會跟著大變動的，不一定是你從中間插入就可以完成的。
原來的那個程序和你前面的條件相差太多，所以整個結構也很難相同
所以我又想了新增條件的新結構和之前的不同
  1. Sub TEST2()
  2. Dim i As Integer
  3. Sheets("A").Select
  4. i = 6
  5. Do While Range("B" & i) <> ""
  6.     SSS = Range("B" & i) '觀察變數用,可以刪除這列
  7.     If Range("D" & i) <> "" Then GoTo 100
  8.     Set c = Sheets("B").Columns(1).Find(Range("B" & i), , , , , 2) '尋找是否在存款中有帳戶
  9.     If c Is Nothing Then '如果沒有就執行這個程序
  10.         Range("D" & i) = "不夠"
  11.         GoTo 100
  12.     End If
  13.     QQQ = c.Offset(0, 1).Value '讀取工作表"B"某人的存款
  14.     AAA = QQQ - Range("C" & i) '某人的存款-第一次花費
  15.     Range("D" & i) = AAA
  16.     Set DepRow = Columns(2).Find(Range("B" & i), Range("B" & i), , , , 1) '尋找下一個某人的花費
  17.     Do While DepRow.Offset(0, 2).Value = "" '一直尋找某人的花費,直到找不到為止
  18.         AAA = AAA - DepRow.Offset(0, 1)
  19.         DepRow.Offset(0, 2) = AAA
  20.         Set DepRow = Columns(2).FindNext(DepRow)
  21.         BBB = DepRow.Row '觀察變數用,可以刪除這列
  22.     Loop
  23. 100: '重新還原變數值
  24. AAA = ""
  25. i = i + 1
  26. Set c = Nothing
  27. Loop
  28. MsgBox " TEST! "
  29. End Sub
複製代碼

TOP

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
8#
發表於 2015-4-15 05:20 | 只看該作者
本帖最後由 sabery 於 2015-4-15 05:21 編輯
回復  sabery
呃！我不是版大，我也只是個新學員而已！
試試這個
lpk187 發表於 2015-4-12 23:05


不好意思 版大 最後一問 假使
今天增加一新同學
王小智
1.jpg

可是存款卻沒有他的資料
13.jpg

希望在D出現負數不夠存款 所以顯示
例如
2015/02/13       
呂曉智        200  D欄 = 不夠
2015/02/26
呂曉智        400  D欄 = 不夠
這樣寫
  1. Sub TEST()
  2. Dim i As Integer
  3. Dim j As Integer
  4. Dim B As Long
  5. Sheets("A").Select
  6.        j = 5
  7.     Do While Sheets("B").Range("A" & j) <> ""
  8.            i = 6
  9.         Do While Range("B" & i) <> ""
  10.             If Range("B" & i) = Sheets("B").Range("A" & j) Then
  11.                 B = Sheets("A").Range("C" & i) + B
  12.                 Range("D" & i) = Sheets("B").Range("B" & j) - B
  13.             ElseIf Range("B" & i) <> Sheets("B").Range("A" & j) Then
  14.                 Range("D" & i) = "不夠"
  15.             End If
  16.                 i = i + 1
  17.         Loop
  18.                 B = 0
  19.                 j = j + 1
  20.     Loop
  21. MsgBox " TEST! "
  22. End Sub
複製代碼
可是錯誤  連王小明 都跑掉 !
可以再次指導嗎? 拜託了.

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
7#
發表於 2015-4-12 23:05 | 只看該作者
回復 6# sabery
呃！我不是版大，我也只是個新學員而已！:P
試試這個
  1. For Each arng In Range("D6:D" & Cells(Rows.Count, "D").End(xlUp).Row)
  2.     If arng < 0 Then
  3.         With Range(Cells(arng.Row, 1), Cells(arng.Row, Columns.Count).End(xlToLeft).Address).Interior
  4.             .Color = vbRed
  5.         End With
  6.     Else
  7.         With Range(Cells(arng.Row, 1), Cells(arng.Row, Columns.Count).End(xlToLeft).Address).Interior
  8.             .Color = vbWhite
  9.         End With

  11.     End If
  12. Next
複製代碼

TOP

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
6#
發表於 2015-4-12 05:38 | 只看該作者
回復  sabery
lpk187 發表於 2015-4-11 23:02


目前是有用最笨方法
If Range("D" & i) < 0 Then
                Range("A" & i).Interior.Color = vbRed
                Range("B" & i).Interior.Color = vbRed
                Range("C" & i).Interior.Color = vbRed
                Range("D" & i).Interior.Color = vbRed
                Else
                Range("A" & i).Interior.Color = vbWhite
                Range("B" & i).Interior.Color = vbWhite
                Range("C" & i).Interior.Color = vbWhite
                Range("D" & i).Interior.Color = vbWhite
                End If

不知道有沒有更好方式!?
因為背景換色導致線不見了

TOP

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
5#
發表於 2015-4-12 05:09 | 只看該作者
本帖最後由 sabery 於 2015-4-12 05:11 編輯
回復  sabery
lpk187 發表於 2015-4-11 23:02


            If Range("D" & i) < 0 Then
                Range("D" & i).Interior.Color = vbRed
                Else
                Range("D" & i).Font.Color = vbBlack
                End If
               
版大 再次請教下 !!  
今天 假如想把負數找出來 我文中這樣寫 只有單獨把 Range("M" & i) 該格反紅 如何把整行反紅呢 !!
不好意思 新手上路 真的真的請多耐心指導 !!

TOP

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
4#
發表於 2015-4-12 01:28 | 只看該作者
回復  sabery
lpk187 發表於 2015-4-11 23:02



    非常感謝版大 !!
已知道問題點在哪邊 !!

TOP

sabery

帖子
8 
主題
2 
精華
0 
積分
10 
點名
0  
作業系統
W8 
軟體版本
2003 
閱讀權限
10 
註冊時間
2015-4-11 
最後登錄
2024-9-21 
3#
發表於 2015-4-12 01:06 | 只看該作者
回復 2# lpk187

非常感謝幫助..
可是結果似乎不太正確 !!
4.jpg
王小明 第二次花費變成負數 ...

TOP

        靜思自在 : 愛不是要求對方，而是要由自身的付出。
12
返回列表 上一主題