[發問] 在單一欄位中計算有無負值

Changbanana

在A欄中計算欄位有無負值
如工作表1

下載 (35.52 KB)

2016-8-22 14:58

寫的程式碼如下:

1. Sub CheckNegativeNumber()
   
2. Dim ng As Integer
   
3. 
   
4. Worksheets("工作表1").Activate
   
5. 
   
6. Range("A500").FormulaR1C1 = "=COUNTIF(R[-499]C:R[-1]C,""<0"")"
   
7. ng = Range("A500").Value
   
8. MsgBox "負數共有 :" & ng & "筆"
   
9. 
   
10. End Sub

複製代碼

現在的問題是A欄的資料目前沒有很多
所以先設定在A500這儲存格下公式
但未來如果超過500筆就必須在修改程式碼

有什麼方法可以不要指定儲存格
直接搜尋目前的欄位有無負值，後用MsgBox顯示出負數有幾筆~~

麻煩各位了~~Thank you :)

stillfish00

回復 1# Changbanana
ng = Evaluate("COUNTIF(A:A,""<0"")")

Changbanana

回復 2# stillfish00
謝謝你~ 成功解決，不用在特定儲存格下公式了

Evaluate 的用法是?
可否解說一下~

stillfish00

回復 3# Changbanana
這邊Evaluate單純是計算公式後傳回結果，參數必須是字串
也可以寫成中括號，如
ng = [COUNTIF(A:A,"<0")]

Changbanana

回復 4# stillfish00


    謝謝您的詳細解說~
    學到了一課:)

Changbanana

回復 2# stillfish00
   
請教您若在A欄編號有1234&-1234
如圖:

下載 (4.56 KB)

2016-10-17 15:10

編號去掉前面有" - "不計算
只計算正常的1234.1555.1556.1777.1899.1890.9999.9997這些編號即可
-1234.-1890忽略不看

以下是修改的程式碼但結果不是正確的

1. Sub CNN()
   
2. Dim ng As Integer
   
3. Dim rg  As Range
   
4. Dim row As Long
   
5. Set rg = Worksheets("工作表1").Range("A1")
   
6. row = 2
   
7. Do While LEFT(rg(row, 1),1) <> "-"
   
8. ng = Evaluate("COUNTIF(B:B,""<0"")")
   
9. row = row + 1
   
10.   Loop
    
11. If ng <> 0 Then
    
12. MsgBox "有 : " & ng & " 筆" & "負數!!!  ", vbExclamation, "  警  示 "
    
13. Else
    
14. MsgBox "沒有負的", vbOKOnly, " "
    
15. End If
    
16. End Sub

複製代碼

結果會跑出三筆負數
但正確結果是只有一筆
這樣程式碼該怎麼修改~

GBKEE

回復 6# Changbanana
試試看

1. Option Explicit
   
2. Sub CNN()
   
3.     Dim ng As Integer
   
4.     Dim rg  As Range
   
5.     Dim row As Long
   
6.     Set rg = Worksheets("工作表1").Range("A1")
   
7.     row = 2
   
8.     Do While rg(row) <> ""
   
9.          If rg(row) > 0 And rg(row, 2) < 0 Then ng = ng + 1
   
10.         row = row + 1
    
11.     Loop
    
12.     If ng <> 0 Then
    
13.         MsgBox "有 : " & ng & " 筆" & "負數!!!  ", vbExclamation, "  警  示 "
    
14.     Else
    
15.         MsgBox "沒有負的", vbOKOnly, " "
    
16.     End If
    
17. End Sub

複製代碼

Changbanana

回復 7# GBKEE


謝謝您提供的程式碼~結果是成功的唷