excel - 如何按特定顺序将 Excel 注释打印到多个工作表？

Question

我正在做一个项目，我想在另一个工作表的单元格中以特定顺序列出评论。
在一张纸上，我想要以下评论:

5C期

5B期

5A期

第四期

三期B

三期

2A期

在另一张纸上，我想要以下评论:

3C期

2B期

在另一张纸上的评论:

一期

我目前已经找到并更改了以下内容以阅读所有评论并列出 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

Answer 1

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

在下面的代码中，我假设您的搜索顺序与您在问题中列出的一样，并且我只完成了第一张工作表。将原理扩展到其他工作表对您来说应该不难。

我使用了一个简单的 Find方法，但您可以使用适合您目的的任何方法。但是，您需要注意这一点，因为即使在您的问题中也存在拼写错误(例如第 2 页上的“Phase”和“3C”之间的空格，以及您的“phase1”处的小写“p”)引用表。如果您的数据不干净，那么您需要编写代码来清理它或使您的查找程序更加复杂。

那么，原则上，您的代码结构可能看起来像这样:

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