麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] Msgbox顯示符合條件的加總 [打印本頁]

作者: cowww 時間: 2021-7-10 13:26 標題: 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
這是結果
[attach]33563[/attach]

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

作者: samwang 時間: 2021-7-10 16:22

回復 1# cowww

不好意思不太能理解需求，符合是什麼條件? 可以在解釋詳細是一點且提供附件測試嗎?感謝

作者: cowww 時間: 2021-7-12 07:57

回復 2# samwang

條件是"機台"欄位有資料的比數加總，空白欄位不算

至於檔案的部分，因為它有連結另一個ECXEL檔，另一個ECXEL檔容量很大，暫時無法提供
檔案的部分我會再想想辦法

作者: cowww 時間: 2021-7-12 09:49

回復 2# samwang

老闆她希望可以針對"機台"欄位有機台的做加總，空白的不要算進去

[attach]33587[/attach]

作者: samwang 時間: 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

作者: cowww 時間: 2021-7-12 10:43

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

[attach]33588[/attach]

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

作者: samwang 時間: 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

作者: cowww 時間: 2021-7-12 12:38

回復 7# samwang

非常感謝samwang大大的解答
[attach]33589[/attach]

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