我有一个非常复杂的Excel VBA项目,其中包含多个注释和验证,并且几天前遇到了一些奇怪的问题。 碰巧在向工作表中添加了一些额外的注释后,在验证单元格中验证后,在验证后立即执行了一些随机单元格的注释形状。 经过调查和一些测试后,我能够使用以下代码在空工作表上复制问题:
Sub CommentsBug()
Dim rng As Range
Dim i As Long
Dim rngItem As Range
Set rng = ActiveSheet.Range("A1:C25000")
For Each rngItem In rng
rngItem.Cells(1, 1).Value = i
If rng.Comment Is Nothing Then rngItem.AddComment
rngItem.Comment.Text "Comment # " & i
i = i + 1
Next
ActiveSheet.Range("E1").Activate
ActiveCell.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5"
End Sub
在代码执行后,我有一个随机单元格出现在验证单元格内的评论框(由于缺少代表而无法放置截图)。如果我将最后处理的单元格更改为C20000,则不会出现问题。 该系统是Excel 2013 32位Office,Win 7 64。 我会很高兴任何建议和解决方法。
更新和快速修复:
在BruceWayne的帮助下,最终可以快速修复(见下面的批准答案)。以某种方式将For Each语句更改为For并处理单独的单元格范围。 这似乎是一个错误,请参阅John Coleman和BruceWayne关于其具体细节的重要评论。希望来自微软的人会遇到它,我也在answers.microsoft.com发布了问题。 只要我已经有一个充满数据的工作表,以下注释更新代码为我工作,以摆脱出现的评论框(大张纸需要惊人的大量时间 - 很多小时,把你的行数/循环中的列而不是3000/500,如果您没有单元保护,请删除保护/取消保护语句):
Public Sub RestoreComments()
Dim i As Long
Dim j As Long
Dim rng As Range
Dim commentString As String
Application.ActiveSheet.Unprotect
Application.ScreenUpdating = False
For i = 1 To 3000
For j = 1 To 500
Set rng = Cells(i, j)
If Not rng.comment Is Nothing Then
commentString = rng.comment.Shape.TextFrame.Characters.Text
'commentString = GetStringFromExcelComment(rng.comment)
'see Update #2
rng.comment.Delete
rng.AddComment
rng.comment.Text commentString
rng.comment.Shape.TextFrame.AutoSize = True
End If
Next j
Next i
Application.ScreenUpdating = True
Application.ActiveSheet.Protect userinterfaceonly:=True
End Sub
更新#2
在执行恢复注释时,我还遇到了另一个使用comment.Shape.TextFrame.Characters.Text时注释字符串超过255个字符的转换问题。如果您有长注释,请使用以下代码返回注释字符串:
'Addresses an Excel bug that returns only first 255 characters
'when performing comment.Shape.TextFrame.Characters.Text
Public Function GetStringFromExcelComment(comm As comment) As String
Dim ifContinueReading As Boolean
Dim finalStr As String, tempStr As String
Dim i As Long, commStrLimit As Long
ifContinueReading = True
commStrLimit = 255
i = 1
finalStr = ""
Do While ifContinueReading
'Error handling addresses situation
'when comment length is exactly the limit (255)
On Error GoTo EndRoutine
tempStr = comm.Shape.TextFrame.Characters(i, commStrLimit).Text
finalStr = finalStr + tempStr
If Len(tempStr) < commStrLimit Then
ifContinueReading = False
Else
i = i + commStrLimit
End If
Loop
EndRoutine: GetStringFromExcelComment = finalStr
End Function
在以下线程中找到了解决方案(略微更改以解决与限制完全匹配的字符串): Excel Comment truncated during reading
答案 0 :(得分:3)
因此,在调整代码后,我发现如果更改For()循环,则可以停止显示注释。试试这个:
Sub CommentsBug()
Dim rng As Range
Dim i As Long
Dim rngItem As Range
Dim ws As Worksheet
Dim k As Integer, x As Integer
Set ws = ActiveSheet
Application.ScreenUpdating = False
Set rng = ws.Range("A1:C25000")
For k = 1 To 25000
If i > 25000 Then Exit For
For x = 1 To 3
Set rngItem = Cells(k, x)
Cells(k, x).Value = i
If rng.Comment Is Nothing Then rngItem.AddComment
rngItem.Comment.Text "Comment # " & i
rngItem.Comment.Visible = False
rngItem.Comment.Shape.TextFrame.AutoSize = True
i = i + 1
Next x
Next k
ws.Range("E1").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5"
Application.ScreenUpdating = True
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub
注意:这可能需要一段时间才能运行,但它并没有像你那样弹出相同的随机评论。另外,至于为什么这个工作而另一个For()循环不胜,我不知道。我怀疑它与Excel使用验证的方式有关,而不是与代码有关(但这是纯粹的推测,也许其他人知道发生了什么)。
答案 1 :(得分:1)
这个kludge似乎有用(虽然不能保证底层的bug会在其他地方冒泡到表面)
Sub CommentsBug()
Dim rng As Range
Dim i As Long
Dim rngItem As Range
Dim kludgeIndex As Long
Dim kludgeRange As Range
Dim temp As String
Application.ScreenUpdating = False
Set rng = ActiveSheet.Range("A1:C25000")
kludgeIndex = rng.Cells.Count Mod 65536
For Each rngItem In rng
rngItem.Cells(1, 1).Value = i
If i = kludgeIndex Then Set kludgeRange = rngItem
If rngItem.Comment Is Nothing Then rngItem.AddComment "Comment # " & i
i = i + 1
Next
Application.ScreenUpdating = True
ActiveSheet.Range("E1").Activate
ActiveCell.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5"
If Not kludgeRange Is Nothing Then
Debug.Print kludgeRange.Address 'in case you are curious
temp = kludgeRange.Comment.Text
kludgeRange.Comment.Delete
kludgeRange.AddComment temp
End If
End Sub
当如上所述运行时,kludgeRange是单元格$ C $ 3155 - 显示9464.如果25000变为26000,kludgeRange变为单元格$ C $ 4155,显示12464.这是一个真正奇怪的kludge驱除鬼魂的地方从细胞E1你必须走几千个细胞。