如何按特定顺序将 excel 条评论打印到多个工作表?

How can i print excel comments to multiple worksheets in a specific order?

我正在做一个项目,我想在单元格中按特定顺序列出另一项作品的评论sheet。 在一个 sheet 中,我想要评论:

在另一个sheet中我想要评论:

并且在另一个sheet评论中:

我目前找到并修改了以下内容以阅读所有评论并制作 1 个列表,但评论出现的顺序不是我想要的。

有人能给我指出正确的方向吗?

Sub Afgeronderechthoek1_Klikken()
    Application.ScreenUpdating = False

    Dim commrange As Range
    Dim mycell As Range
    Dim curwks As Worksheet
    Dim newwks As Worksheet
    Dim i As Long

    Set curwks = ActiveSheet

    On Error Resume Next
    On Error Resume Next
    Set commrange = curwks.Cells _
        .SpecialCells(xlCellTypeComments)
    On Error GoTo 0

    If commrange Is Nothing Then
       MsgBox "no comments found"
       Exit Sub
    End If

    Set newwks = Worksheets.Add

     newwks.Range("B1:E1").Value = _
         Array("Comment")

    i = 50
    For Each mycell In commrange
       With newwks
         i = i - 1
         On Error Resume Next
         .Cells(i, 5).Value = mycell.Comment.Text
       End With
    Next mycell

    Application.ScreenUpdating = True

End Sub

通常情况下,如果您希望数据 'sorted' 以特定顺序排列,则需要定义该排序顺序。 Excel 的 Sort 方法确实很复杂,可以管理一些常用的排序顺序,但你的案例不仅基于 Comments,而且非常特殊。因此,您的代码的开头将需要定义您想要的排序顺序。这可以通过多种方式完成;一个简单的方法可能只是创建一个您想要的顺序的数组,然后依次搜索每个数组项。然后将您的结果按此顺序写入您的工作sheet应该是一项微不足道的任务。

在下面的代码中,我假定您的搜索顺序与您在问题中列出的顺序相同,而我只执行了第一个 sheet。将原理扩展到其他sheet对你来说应该不难。

我使用了一个简单的 Find 方法,但您可以使用适合您目的的任何方法。不过,您需要注意这一点,因为即使在您的问题中也有拼写错误(例如 "Phase" 和 sheet 2 上的“3C”之间的 space,以及较低的case "p" at "phase1" in your reference sheet。如果你的数据不是clean,那么你需要编写代码来清理它或者使您的查找程序更复杂。

原则上,您的代码结构可能如下所示:

Dim seq1 As Variant
Dim rng As Range, foundCell As Range
Dim searchText As Variant
Dim r As Long

'Define the sequences.
seq1 = Array("Phase5C", "Phase5B", "Phase5A", _
             "Phase4", _
             "Phase3B", "Phase3A", _
             "Phase2A")

'Acquire the commented cells.
Set rng = Sheet1.Cells.SpecialCells(xlCellTypeComments)

'Loop through the sequence in order
'and write results to Sheet2.
r = 1
For Each searchText In seq1
    Set foundCell = rng.Find(searchText, , _
                             xlValues, _
                             xlWhole, _
                             xlByRows, _
                             xlNext, _
                             True)
    'If there's a match, write it to the sheet.
    If Not foundCell Is Nothing Then
        Sheet2.Cells(r, 1).Value = foundCell.Comment.Text
        r = r + 1
    End If
Next