Question

警告，我是新手。

目标：创建一个“评论”表，其中包含所选当前工作表的所有评论。这是我的工作表的样子：

我希望表单看起来的方式是：

工作表实际的显示方式是：

基本上，我不想将“父地址”用于“注释”列，而是使用单元格上方的标题。例如，我不想要$ A $ 2但实际上希望它引用标题为“Responsible Party”。我最初的想法是，我可以使用命名范围，但事实证明它超出了我的能力范围。

我不是一个强大的程序员。请记住这一点。

代码如下：

public class AlterMe {
    private ClassA someField;
    public void doSomething() {
        someField.doSomething(Object someArg);
    }
}

感谢您的时间。

Answer 1

这对新手来说绝对不错:)试试这个：

    ...
Else: Set ws = Worksheets("Comments")
End If

Dim iRow As Long   ' you have a better control this way directly specifying the target cell

' header needs to written only once - out of loop

ws.Range("A1").Value = "Comment In"
ws.Range("B1").Value = "Comment By"
ws.Range("C1").Value = "Comment"

With ws.Range("A1:C1")
    .Font.Bold = True
    .Interior.Color = RGB(189, 215, 238)
    .Columns.ColumnWidth = 20
End With

iRow = 2        ' first empty row 
For Each ExComment In CS.Comments
    ws.Cells(iRow, 1).Value = CS.Cells(1, ExComment.Parent.Column)  ' value in 1st row of column of comment
    ws.Cells(iRow, 2).Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
    ws.Cells(iRow, 3).Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    iRow = iRow + 1
Next ExComment

End Sub

Answer 2

只需添加一个标题值进行更改，并在添加注释时从底部开始处理，稍微缩短代码，并从循环中删除一些内容。

Sub ExtractComments()

Dim ExComment As Comment
Dim i As Long
Dim ws As Worksheet
Dim CS As Worksheet
Set CS = ActiveSheet
If ActiveSheet.Comments.Count = 0 Then Exit Sub

For Each ws In Worksheets
  If ws.Name = "Comments" Then i = 1
Next ws

If i = 0 Then
  Set ws = Worksheets.Add(After:=ActiveSheet)
  ws.Name = "Comments"
Else: Set ws = Worksheets("Comments")
End If

With ws
    .Range("A1").Value = "Comment In"
    .Range("B1").Value = "Comment By"
    .Range("C1").Value = "Comment"
    With .Range("A1:C1")
        .Font.Bold = True
        .Interior.Color = RGB(189, 215, 238)
        .Columns.ColumnWidth = 20
    End With
    For Each ExComment In CS.Comments
        .Range("A" & Rows.Count).End(xlUp)(2).Value = CS.Cells(1, ExComment.Parent.Column)
        .Range("B" & Rows.Count).End(xlUp)(2).Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
        .Range("C" & Rows.Count).End(xlUp)(2).Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    Next ExComment
End With

End Sub

Answer 3

使用：

      ws.Range("A2").Value = ExComment.Parent.End(xlUp).Value

这样：

    If ws.Range("A2") = "" Then
      ws.Range("A2").Value = ExComment.Parent.End(xlUp).Value
      ws.Range("B2").Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
      ws.Range("C2").Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    Else
      ws.Range("A1").End(xlDown).Offset(1, 0) = ExComment.Parent.End(xlUp).Value
      ws.Range("B1").End(xlDown).Offset(1, 0) = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
      ws.Range("C1").End(xlDown).Offset(1, 0) = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    End If

虽然您可以考虑以下重构代码

Sub ExtractComments()
    If ActiveSheet.Comments.count = 0 Then Exit Sub

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets("Comments")
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(After:=ActiveSheet)
        ws.Name = "Comments"
    End If

    Dim ExComment As Comment
    With ws
        With .Range("A1:C1")
        .Value = Array("Comment In", "Comment By", "Comment")
        .Font.Bold = True
        .Interior.Color = RGB(189, 215, 238)
        .Columns.ColumnWidth = 20
        End With

        For Each ExComment In ActiveSheet.Comments
            .Cells(.Rows.count, 1).End(xlUp).Offset(1).Resize(, 3) = Array(ExComment.Parent.End(xlUp).Value, _
                                                                        Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1), _
                                                                        Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":")))
        Next ExComment
    End With
End Sub

创建评论表

3 个答案: