多个Excel注释和validation.add奇怪的行为

我有一个相当复杂的Excel VBA项目,其中包含多个注释和validation,并在几天前出现了一些奇怪的问题。 发生这种情况后,添加了一些额外的意见,工作表validation.add停止工作正确显示一些随机单元格的评论形状后立即validation.add执行validation单元格内。 经过调查和一些testing,我能够用下面的代码在一个空的工作表上复制问题:

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 

代码执行后,我有一个随机单元格出现在validation单元格内的评论框(由于缺乏代表不能放置屏幕截图)。如果我将最后处理的单元格更改为C20000,问题不会出现。 该系统是Excel 2013 32位办公室,Win 7 64.我会很乐意为任何build议和步行。

更新和快速修复:

在BruceWayne的帮助下,终于有可能得到一个快速的解决scheme(见下面的批准答案)。 以某种方式将For Each语句更改为For和处理单独的单元格范围。 这似乎是一个错误,请看下面的约翰·科尔曼和布鲁斯·韦恩关于它的具体细节的重要评论。 希望来自微软的人会遇到它,我也发布在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个字符的注释string的传输问题。 如果你有很长的评论使用下面的代码来返回评论string:

 '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 

该解决scheme在以下线程中find(略有更改以解决与限制完全匹配的string): Excel注释在读取期间被截断

所以,在调整代码后,我发现如果你改变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 

注意:这可能需要稍长的时间才能运行,但不会像您的popup式那样提供相同的随机评论。 另外,至于为什么这个作品和其他For()循环不会,我不知道。 我怀疑这是Excel使用Validation的方式,而不是代码中的东西(但是这是纯粹的猜测,也许别人知道怎么回事)。

这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.这是一个真正奇怪的混乱,从单元格E1驱除重影你必须去数千个细胞。