判断区域的值，等于另一单元格，否则弹出对话框

edepei

这是一份简化之后的表格，会由不同的人填写数据，然后经常会出现填写的数据汇总后不等100%；

灰色区域是由不同的人填写相应的占比，然后将填入的占比进行求和

我的问题是：如果合计的数据不等于目标的数据，则表格不能保存，并弹出对话框可以提示：例如果不等百分百提示内容“男装上身占比未等于100%，保存操作被取消”

提示内容根据表头的项目来

工作簿1.rar (10.19 KB, 下载次数: 8)

2019-9-29 13:32 上传

点击文件名下载附件

lsdongjh

在thisworkbook下

1. Option Explicit
   
2. 
   
3. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
4.     If Not CheckVal Then Cancel = True
   
5. End Sub
   
6. 
   
7. Function CheckVal() As Boolean
   
8.     Dim sh As Worksheet, lngCol As Long
   
9.     Dim arrTarget As Variant
   
10.     Dim arrSum As Variant
    
11.     Dim strSex As String, strType As String, strVal As String
    
12.    
    
13.     Set sh = Sheets("Sheet1")
    
14.     arrTarget = sh.Range("B3:J5")
    
15.     arrSum = sh.Range("B6:J6")
    
16.    
    
17.     For lngCol = LBound(arrTarget, 2) To UBound(arrTarget, 2)
    
18.         strSex = arrTarget(1, lngCol)
    
19.         strType = arrTarget(2, lngCol)
    
20.         strVal = arrTarget(3, lngCol)
    
21.         If arrTarget(3, lngCol) <> arrSum(1, lngCol) Then
    
22.             MsgBox strSex & strType & "未等于" & Format(strVal, "0.00%")
    
23.             CheckVal = False
    
24.             Exit Function
    
25.         End If
    
26.     Next
    
27.    
    
28.     CheckVal = True
    
29. End Function
    

复制代码

edepei

lsdongjh 发表于 2019-9-29 15:26
在thisworkbook下

感谢感谢，太厉害了，代码运行出来的效果就是我想要的。