返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
1# 跳轉到 »
發表於 2021-7-10 16:22 | 顯示全部帖子
回復 1# cowww


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

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
2#
發表於 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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
3#
發表於 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

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題