上周,我对上一个问题有了很好的回答,我回来寻求更多的指导。
我们有一个vba宏,它通过一个Word文档中的修改数来运行,然后根据单词计数给我们一个困难的分数。最近,我们已经开始使用两个不同的过程,需要两个不同的等级,但它们是基于相同的算法(修订次数/字数)。本质上,我正在尝试做一个If ElseIf,它将根据所使用的过程返回分数。前端计算都是一样的,所以这只是一个实现正确定义的问题。
当我添加askMsg问题时,原始进程仍然完好无损;但是,当我试图运行第二个进程时,返回值是0(应该是1-10值)。无论我将新进程作为If还是ElseIf,都不重要;原始代码的工作原理是一样的,而新的代码实际上是相同的。我已经包含了完整的代码,并指出了与'XX有关的行。
Sub Grade()
Dim oDoc As Document
Dim nWords As Long
Dim commentCount As Long
Dim revisionCount As Long
Dim totalRev As Long
'Dim hasChanges As Boolean
'Dim oRevision As Revision
'Dim oComment As comment
Dim rDensity As Variant
Dim mGrade As Long
Set oDoc = ActiveDocument
' update and count number of words
nWords = oDoc.Range.ComputeStatistics(wdStatisticWords)
' The following line was added to handle an accidental macro-button press on an empty
' document. It executes only if nWords is 0 to avoid the divide-by-zero error; it does not handle an
' error in getting the word count.
If nWords = 0 Then mGrade = 10: GoTo ExitManuscriptGrade
'check to see if the document has changes,
revisionCount = oDoc.Revisions.count ' get the revision count
commentCount = oDoc.Comments.count ' get the number of comments
' all the following scoring code was left exactly the same
totalRev = commentCount + revisionCount
'calculate density of revisions
rDensity = totalRev / nWords
'XX Here is where the issues start XX
askMsg = "Is this a Top Tier Sub?"
msgResult = MsgBox(askMsg, vbYesNo)
Select Case msgResult
Case vbYes
TopTier = True
Case vbNo
TopTier = False
End Select
If TopTier = True Then
'Assign manuscript grade
If rDensity > 0.4 Then
mGrade = 1
ElseIf rDensity <= 0.4 And rDensity > 0.37 Then
mGrade = 2
ElseIf rDensity <= 0.37 And rDensity > 0.34 Then
mGrade = 3
ElseIf rDensity <= 0.34 And rDensity > 0.3 Then
mGrade = 4
ElseIf rDensity <= 0.3 And rDensity > 0.26 Then
mGrade = 5
ElseIf rDensity <= 0.22 And rDensity > 0.26 Then
mGrade = 6
ElseIf rDensity <= 0.18 And rDensity > 0.22 Then
mGrade = 7
ElseIf rDensity <= 0.16 And rDensity > 0.18 Then
mGrade = 8
ElseIf rDensity <= 0.13 And rDensity > 0.16 Then
mGrade = 9
ElseIf rDensity <= 0.13 Then
mGrade = 10
End If
'Message box output for testing
MsgBox (mGrade) ' XX mGrade is always set to zero XX
Exit Sub
ElseIf TopTier = False Then
'XX This is where the code originally went prior to adding in askMsg XX
'Assign manuscript grade
If rDensity > 0.31 Then
mGrade = 1
ElseIf rDensity <= 0.31 And rDensity > 0.27 Then
mGrade = 2
ElseIf rDensity <= 0.27 And rDensity > 0.24 Then
mGrade = 3
ElseIf rDensity <= 0.24 And rDensity > 0.2 Then
mGrade = 4
ElseIf rDensity <= 0.2 And rDensity > 0.18 Then
mGrade = 5
ElseIf rDensity <= 0.18 And rDensity > 0.16 Then
mGrade = 6
ElseIf rDensity <= 0.16 And rDensity > 0.13 Then
mGrade = 7
ElseIf rDensity <= 0.13 And rDensity > 0.11 Then
mGrade = 8
ElseIf rDensity <= 0.11 And rDensity > 0.09 Then
mGrade = 9
ElseIf rDensity <= 0.09 Then
mGrade = 10
End If
'Message box output for testing
MsgBox (mGrade) ' XX This outputs the mGrade correctly XX
End If
Exit Sub
' Execution jumps to this label if there are no words in the document
ExitManuscriptGrade:
End Sub我不确定我是缺少了一个小命令,还是需要其他一些语句,但是任何帮助都会非常感谢!
发布于 2017-03-10 20:23:54
您有一些条件可以使永远不会为真,检查您的逻辑,例如:If rDensity <= 0.22 And rDensity > 0.26 Then。在这种情况下,rDensity不能是LTE .22和GT .26。接下来的三个条件也有相同的错误。
看看这个,它将向您展示一些基本的调试技术,您可以使用这些技术逐步完成代码并在将来排除故障:
http://www.cpearson.com/excel/DebuggingVBA.aspx
我想这会解决这个问题。请注意,我已经将您的If/ElseIf语句重组为Case语句,并使用布尔表达式得出TopTier值(而不是使用不需要的Case语句)。
Sub Grade()
Dim oDoc As Document
Dim nWords As Long
Dim commentCount As Long
Dim revisionCount As Long
Dim totalRev As Long
'Dim hasChanges As Boolean
'Dim oRevision As Revision
'Dim oComment As comment
Dim rDensity As Double
Dim mGrade As Long
Set oDoc = ActiveDocument
' update and count number of words
nWords = oDoc.Range.ComputeStatistics(wdStatisticWords)
' The following line was added to handle an accidental macro-button press on an empty
' document. It executes only if nWords is 0 to avoid the divide-by-zero error; it does not handle an
' error in getting the word count.
If nWords = 0 Then GoTo ExitManuscriptGrade
' check to see if the document has changes,
revisionCount = oDoc.Revisions.count ' get the revision count
commentCount = oDoc.Comments.count ' get the number of comments
' all the following scoring code was left exactly the same
totalRev = commentCount + revisionCount
' calculate density of revisions
rDensity = totalRev / nWords
askMsg = "Is this a Top Tier Sub?"
msgResult = MsgBox(askMsg, vbYesNo)
TopTier = msgResult = vbYesNo
If TopTier Then
'Assign manuscript grade
Select Case True
Case rDensity > 0.4
mGrade = 1
Case 0.37 < rDensity <= 0.4
mGrade = 2
Case 0.34 < rDensity <= 0.37
mGrade = 3
Case 0.3 < rDensity <= 0.34
mGrade = 4
Case 0.26 < rDensity <= 0.3
mGrade = 5
Case 0.22 < rDensity <= 0.26
mGrade = 6
Case 0.18 < rDensity <= 0.22
mGrade = 7
Case 0.16 < rDensity <= 0.18
mGrade = 8
Case 0.13 < rDensity <= 0.16
mGrade = 9
Case rDensity <= 0.13
mGrade = 10
End If
'Message box output for testing
MsgBox (mGrade) ' XX mGrade is always set to zero XX
Else
'XX This is where the code originally went prior to adding in askMsg XX
'Assign manuscript grade
Select Case True
Case rDensity > 0.31
mGrade = 1
Case 0.27 < rDensity <= 0.31
mGrade = 2
Case .24 < rDensity <= .27
mGrade = 3
Case 0.2 < rDensity <= .24
mGrade = 4
Case 0.18 < rDensity <= 0.2
mGrade = 5
Case 0.16 < rDensity <= 0.18
mGrade = 6
Case 0.13 < rDensity <= 0.16
mGrade = 7
Case 0.11 < rDensity <= 0.13
mGrade = 8
Case 0.09 < rDensity <= 0.11
mGrade = 9
Case rDensity <= 0.09
mGrade = 10
End Select
'Message box output for testing
MsgBox (mGrade) ' XX This outputs the mGrade correctly XX
End If
' Execution jumps to this label if there are no words in the document
ExitManuscriptGrade:
End Subhttps://stackoverflow.com/questions/42727035
复制相似问题