返回列表 上一主題 發帖

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

[發問] 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
這是結果
Msgbox顯示加總.PNG
2021-7-10 13:25


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

回復 1# cowww


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

TOP

回復 2# samwang


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

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

TOP

回復 2# samwang


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

匯入資料TEST123.zip (317.29 KB)

TOP

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

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

Msgbox加總.PNG
2021-7-12 10:41


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

TOP

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

回復 7# samwang


非常感謝samwang大大的解答
.PNG
2021-7-12 12:38

TOP

        靜思自在 : 人的眼睛長在前面,只看到別人的缺點,絲毫看不到自己的缺點。
返回列表 上一主題