Question

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

Phase5C
Phase5B
Phase5A
第4阶段
Phase3B
Phase3A
Phase2A

在另一张纸上，我想发表以下评论：

第3C阶段
Phase2B

在另一张纸上，评论：

第一阶段

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

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

1 个答案: