Excel VBA，如果它所在的单元格可见，则在新工作表上显示注释

标题很难满足我需要的全部内容，所以请阅读所有的文字。

我正在尝试使用一个button来创build一个工作表，以便于理解的格式向用户显示所有工作表上的所有评论，这些格式基本上充当工作簿的亮点。

问题是代码目前显示所有评论，但我只希望该人看到目前可见的评论。 我是什么意思？ 并非所有的用户都可以看到所有的图纸或所有的行和列。 某些数据是隐藏的，因为它不属于它们。 我只希望他们看到任何可见的表单上当前可见的数据。

示例（不是真实的情况）; 一个Excel文件有3张（Sheet1，Sheet2，Sheet3）。 Johnlogin（使用Select Case VBA来隐藏他不需要的数据），并可以看到Sheet1和Sheet2，但是看不到每个工作表中的特定行，例如Sheet1中的第2行和第F列以及Sheet2中的第5行和第K列。 他不需要看到他看不到的行，列和表单的注释。

如何修改下面的代码，只显示他可以看到的单元格的注释？

注：我没有创build这个代码，只是采用它，因为它几乎适合我的需要。

Sub ShowCommentsAllSheets() Application.ScreenUpdating = False Dim commrange As Range Dim mycell As Range Dim ws As Worksheet Dim newwks As Worksheet Dim i As Long Set newwks = Worksheets.Add newwks.Range("A1:E1").Value = _ Array("Sheet", "Address", "Name", "Value", "Comment") For Each ws In ActiveWorkbook.Worksheets On Error Resume Next Set commrange = ws.Cells.SpecialCells(xlCellTypeComments) On Error GoTo 0 If commrange Is Nothing Then Else i = newwks.Cells(Rows.Count, 1).End(xlUp).Row For Each mycell In commrange With newwks i = i + 1 On Error Resume Next .Cells(i, 1).Value = ws.Name .Cells(i, 2).Value = mycell.Address .Cells(i, 3).Value = mycell.Name.Name .Cells(i, 4).Value = mycell.Value .Cells(i, 5).Value = mycell.Comment.Text End With Next mycell End If Set commrange = Nothing Next ws newwks.Cells.WrapText = False newwks.Columns("E:E").Replace What:=Chr(10), _ Replacement:=" ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Application.ScreenUpdating = True End Sub 

我相信我需要添加这个代码来解决这个问题：

  Comments = 1 For Each MyComments In ActiveSheet.Comments If MyComments.Visible = True Then Comments = 0 End If Next If Comments = 1 Then Application.DisplayCommentIndicator = xlCommentAndIndicator Else Application.DisplayCommentIndicator = xlCommentIndicatorOnly End If 

不过，我正在努力将其融入代码中。 我应该如何继续？

Answer 1

修改代码以覆盖可见表格，然后覆盖未隐藏的单元格。

 Sub ShowCommentsAllSheets() Application.ScreenUpdating = False Dim commrange As Range Dim mycell As Range Dim ws As Worksheet Dim newwks As Worksheet Dim i As Long Set newwks = Worksheets.Add newwks.Range("A1:E1").Value = _ Array("Sheet", "Address", "Name", "Value", "Comment") For Each ws In ActiveWorkbook.Worksheets If ws.Visible = xlSheetVisible Then On Error Resume Next Set commrange = ws.Cells.SpecialCells(xlCellTypeComments) On Error GoTo 0 If Not commrange Is Nothing Then i = newwks.Cells(Rows.Count, 1).End(xlUp).Row For Each mycell In commrange If Not (mycell.EntireRow.Hidden Or mycell.EntireColumn.Hidden) Then With newwks i = i + 1 On Error Resume Next .Cells(i, 1).Value = ws.Name .Cells(i, 2).Value = mycell.Address .Cells(i, 3).Value = mycell.Name.Name .Cells(i, 4).Value = mycell.Value .Cells(i, 5).Value = mycell.Comment.Text End With End If Next mycell End If Set commrange = Nothing End If Next ws newwks.Cells.WrapText = False newwks.Columns("E:E").Replace What:=Chr(10), _ Replacement:=" ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Application.ScreenUpdating = True End Sub