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

cowww

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
這是結果

下載 (58.26 KB)

2021-7-10 13:25

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

samwang

回復 1# cowww


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

cowww

回復 2# samwang


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

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

cowww

回復 2# samwang


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

匯入資料TEST123.zip (317.29 KB)

下載次數: 3

2021-7-12 09:49

samwang

回復 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

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

下載 (115.19 KB)

2021-7-12 10:41

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

samwang

回復  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

回復 7# samwang


非常感謝samwang大大的解答

下載 (144.17 KB)

2021-7-12 12:38