[發問] Msgbox顯示符合條件的加總

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
Dim xRg As Range
Application.ScreenUpdating = False
      For Each xRg In Range("I6:I1000")
         If xRg.Value = "" Then
            xRg.EntireRow.Hidden = True
         Else
            xRg.EntireRow.Hidden = False
         End If
      Next xRg
Application.ScreenUpdating = True

MsgBox "完成!"

End Sub
這是結果

希望"完成!"的部分可以顯示符合條件的總筆數

樓主熱帖

cowww

中學生 Rank: 2

帖子: 122
主題: 26
精華: 0
積分: 148
點名: 0
作業系統: windos10
軟體版本: office2016
閱讀權限: 20
註冊時間: 2021-7-8
最後登錄: 2023-8-28

8^#

發表於 2021-7-12 12:38 | 只看該作者

回復 7# samwang

非常感謝samwang大大的解答

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

7^#

發表於 2021-7-12 11:03 | 只看該作者

回復 samwang
非常感謝samwang大大的解答

如果可以，只要"I"欄位的總數就好
不需要針對不同的機 ...
cowww 發表於 2021-7-12 10:43

請再試看看，謝謝

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
   Dim xRg As Range, Ar(), a, n%, xD
Set xD = CreateObject("Scripting.Dictionary")
   n = 0
   Application.ScreenUpdating = False
      For Each xRg In Range("I6:I10000")
         If xRg.Value = "" Then
               xRg.EntireRow.Hidden = True
         Else
               xRg.EntireRow.Hidden = False
               If xD.exists(xRg.Value) = False Then
                  xD(xRg.Value) = "": ReDim Preserve Ar(n)
                  Ar(n) = Application.CountIf(Columns("I"), xRg)
                  n = n + 1
               End If
         End If
      Next

       If UBound(Ar) > 0 Then
         For j = 0 To UBound(Ar): a = a + Ar(j): Next
      End If
Application.ScreenUpdating = True

   MsgBox "完成!" & a

End Sub

TOP

cowww

中學生 Rank: 2

帖子: 122
主題: 26
精華: 0
積分: 148
點名: 0
作業系統: windos10
軟體版本: office2016
閱讀權限: 20
註冊時間: 2021-7-8
最後登錄: 2023-8-28

6^#

發表於 2021-7-12 10:43 | 只看該作者

回復 5# samwang
非常感謝samwang大大的解答

如果可以，只要"I"欄位的總數就好
不需要針對不同的機台個別加總

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

5^#

發表於 2021-7-12 09:55 | 只看該作者

回復 4# cowww

請測試看看，謝謝

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
Dim xRg As Range, Ar(), a, n%,xD
Set xD = CreateObject("Scripting.Dictionary")
n = 0
Application.ScreenUpdating = False
      For Each xRg In Range("I6:I10000")
         If xRg.Value = "" Then
            xRg.EntireRow.Hidden = True
         Else
            xRg.EntireRow.Hidden = False
            If xD.exists(xRg.Value) = False Then
                  xD(xRg.Value) = "": ReDim Preserve Ar(n)
                  Ar(n) = Application.CountIf(Columns("I"), xRg)
                  n = n + 1
            End If
         End If
      Next

     a = Join(Ar, ",")
Application.ScreenUpdating = True

MsgBox "完成!" & a

End Sub

TOP

cowww