宏检查多个条件是否合规,并返回带有常规消息的msgbox。问题是该消息不是特定的,并且它会重复很多次,因为有一个循环来检查标准。如果条件失败,有一种方法可以合并一个msgbox,这将是(单元格)地址的结果。
Sub CheckFundsInISAccounts()
'Version 9 change.
Dim c As Range
Dim lstRng As Range
Dim LastRow As Integer
Application.ScreenUpdating = False
Worksheets("DataFile").Activate
Range("U2").Activate
LastRow = Cells(Rows.count, "A").End(xlUp).row
Set lstRng = Range("U2", Range("U65536").End(xlUp))
For Each c In lstRng
If c.Value > 29999 _
And (c.Offset(0, -2).Value = 10 _
Or c.Offset(0, -2).Value = 11 _
Or c.Offset(0, -2).Value = 12 _
Or c.Offset(0, -2).Value = 20 _
Or c.Offset(0, -2).Value = 45 _
Or c.Offset(0, -2).Value = 60 _
Or c.Offset(0, -2).Value = 70) Then
c.Offset(1, 0).Select
Else
'A macro checks for compliance of multiple conditions and returns a msgbox with
'general message.
'The issue is that the message is NOT specific and it is repeated a lot of times as
'there is a loop to check criteria.
'If there a way to incorporate a msgbox which would to be a result of address(es) of
'cells if the condition fails.
MsgBox ("NOT every IS account has a Fund assigned to it. Double-check it")
End If
Next c
Columns("A:W").Select
Selection.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:3)
情侣变化:
OR中的条件移至Case
.Address
捕获单元格地址
Sub CheckFundsInISAccounts()
'Version 9 change.
Dim c As Range
Dim lstRng As Range
Dim LastRow As Integer
Application.ScreenUpdating = False
Worksheets("DataFile").Activate
Range("U2").Select
Debug.Print Rows.Count
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set lstRng = Range("U2", Range("U65536").End(xlUp))
Dim MyAdd As String
For Each c In lstRng
If c.Value > 29999 Then
Select Case (c.Offset(0, -2).Value)
Case 10, 11, 12, 20, 45, 60, 70
c.Offset(1, 0).Select
Case Else
'MyAdd = MyAdd & c.Offset(0, -2).Address & vbCrLf
c.Offset(0, -2).Value = "I am not one of Your Values"
End Select
Else
MyAdd = MyAdd & c.Address & vbCrLf
c.Value = "I am not Greater Than 29999"
End If
Next c
'MsgBox ("Error Addresses are:" & vbCrLf & MyAdd)
Columns("A:W").Select
Selection.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub