Question

所以过去几天我一直在反对这个问题，并且找不到任何帮助。我一直试图从不同范围的细胞中复制细胞评论。然后将这些注释添加到新工作表中。

下面是指向要捕获的数据图片的链接（显然我无法使用新帐户发布图片）。最右边的专栏很有意思。如果选中了复选框，则代码应该仅捕获复选框左侧的单元格。单击按钮后执行整个过程。

我认为问题的代码如下：

Dim start_tests As Long 'start of test selection
    start_tests = 2
Dim end_tests As Long 'end of test selection
    end_tests = 100

Dim tests_used(200) As Variant
Dim tests_indent(200) As Variant
Dim tests_font(200) As Variant
Dim tests_comments(20000) As Variant

'Saving the selected tests to an array
no_act_tests = 1
For i = start_tests To (end_tests)
    If Range("N" & i) = True Then
        tests_used(no_act_tests) = Range("M" & i)
        tests_indent(no_act_tests) = Range("M" & i).IndentLevel
        tests_font(no_act_tests) = Range("M" & i).Font.FontStyle
        'Range("M" & i).Select
        'tests_comments(no_act_tests) = Range("M" & i).SpecialCells(xlCellTypeComments).Select
        tests_comments(no_act_tests) = Range("M" & i).Comment.Text '<- Problem Code
        no_act_tests = no_act_tests + 1
    End If
Next i
no_act_tests = no_act_tests - 1

所以这一切都是为了将每个单元格的注释保存到一个数组以供以后使用。接下来，将创建一个新工作表，并且可以开始填充该列。下面的代码显示了我用来填充单元格注释的内容：

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Creating New Tab~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = tab_name_desk
End With
End With

 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Printing Template~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Worksheets(tab_name_desk)

  .Range("A1").Value = "Browser:"
  .Range("A2").Value = "Resolution:"
  .Range("A3").Value = "Page URL:"
  .Range("B3").Value = url_name

  'displaying all the tests to be done in the first column
  For i = 1 To no_act_tests
    .Range("A" & i + 3).Value = tests_used(i)
    .Range("A" & i + 3).IndentLevel = tests_indent(i)
    .Range("A" & i + 3).Font.FontStyle = tests_font(i)
    'With .Range("A" & i + 3).AddComment
        .Range("A" & i + 3).AddComment.Visible = False
        .Range("A" & i + 3).AddComment = tests_comments(i)
    'End With
  Next i

完整代码如下。除了评论代码之外，它已经过全部测试并且工作正常。

Sub Create_Form()
Application.ScreenUpdating = False

With Worksheets("Setup")

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Creating Variables~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim tab_name As String      'Creates tab_name as a variable
    tab_name = Range("C1").Value     'Stores the value from C1 in the tab_name variable
    tab_name_mobile = tab_name + " - Mobile"
    tab_name_desk = tab_name + " - Desktop"
Dim url_name As String      'Creates url_name as a variable
    url_name = Range("C2").Value     'Stores the value from C2 in the url_name variable


'Indices
Dim start_browse_desk As Long 'start of desktop browser selection
    start_browse_desk = 10
Dim end_browse_desk As Long 'end of desktop browser selection
    end_browse_desk = 14
Dim start_res_desk As Long 'start of desktop resolutions selection
    start_res_desk = 23
Dim end_res_desk As Long 'end of desktop resolutions selection
    end_res_desk = 38

Dim start_browse_mobile As Long 'start of mobile browser selection
    start_browse_mobile = 45
Dim end_browse_mobile As Long 'end of mobile browser selection
    end_browse_mobile = 52
Dim start_res_mobile As Long 'start of mobile resolutions selection
    start_res_mobile = 63
Dim end_res_mobile As Long 'end of mobile resolutions selection
    end_res_mobile = 70

Dim start_tests As Long 'start of test selection
    start_tests = 2
Dim end_tests As Long 'end of test selection
    end_tests = 100

'Arrays
Dim browsers_used_mobile(25) As Variant
Dim browsers_indent_mobile(25) As Variant
Dim browsers_font_mobile(25) As Variant
Dim res_used_mobile(25) As Variant
Dim res_indent_mobile(25) As Variant
Dim res_font_mobile(25) As Variant

Dim browsers_used_desk(25) As Variant
Dim browsers_indent_desk(25) As Variant
Dim browsers_font_desk(25) As Variant
Dim res_used_desk(25) As Variant
Dim res_indent_desk(25) As Variant
Dim res_font_desk(25) As Variant

Dim tests_used(200) As Variant
Dim tests_indent(200) As Variant
Dim tests_font(200) As Variant
Dim tests_comments(20000) As Variant

 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Saving Selections~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Saving the selected desktop browsers to an array
no_act_browsers_desk = 1
For i = start_browse_desk To (end_browse_desk)
    If Range("B" & i) = True Then
        browsers_used_desk(no_act_browsers_desk) = Range("A" & i)
        browsers_indent_desk(no_act_browsers_desk) = Range("A" & i).IndentLevel
        browsers_font_desk(no_act_browsers_desk) = Range("A" & i).Font.FontStyle
        no_act_browsers_desk = no_act_browsers_desk + 1
    End If
Next i
no_act_browsers_desk = no_act_browsers_desk - 1

'Saving the selected desktop resolutions to an array
no_act_res_desk = 1
For i = start_res_desk To (end_res_desk)
    If Range("B" & i) = True Then
        res_used_desk(no_act_res_desk) = Range("A" & i)
        res_indent_desk(no_act_res_desk) = Range("A" & i).IndentLevel
        res_font_desk(no_act_res_desk) = Range("A" & i).Font.FontStyle
        no_act_res_desk = no_act_res_desk + 1
    End If
Next i
no_act_res_desk = no_act_res_desk - 1

'Saving the selected mobile browsers to an array
no_act_browsers_mobile = 1
For i = start_browse_mobile To end_browse_mobile
    If Range("B" & i) = True Then
        browsers_used_mobile(no_act_browsers_mobile) = Range("A" & i)
        browsers_indent_mobile(no_act_browsers_mobile) = Range("A" & i).IndentLevel
        browsers_font_mobile(no_act_browsers_mobile) = Range("A" & i).Font.FontStyle
        no_act_browsers_mobile = no_act_browsers_mobile + 1
    End If
Next i
no_act_browsers_mobile = no_act_browsers_mobile - 1

'Saving the selected mobile resolutions to an array
no_act_res_mobile = 1
For i = start_res_mobile To (end_res_mobile)
    If Range("B" & i) = True Then
        res_used_mobile(no_act_res_mobile) = Range("A" & i)
        res_indent_mobile(no_act_res_mobile) = Range("A" & i).IndentLevel
        res_font_mobile(no_act_res_mobile) = Range("A" & i).Font.FontStyle
        no_act_res_mobile = no_act_res_mobile + 1
    End If
Next i
no_act_res_mobile = no_act_res_mobile - 1

'Saving the selected tests to an array
no_act_tests = 1
For i = start_tests To (end_tests)
    If Range("N" & i) = True Then
        tests_used(no_act_tests) = Range("M" & i)
        tests_indent(no_act_tests) = Range("M" & i).IndentLevel
        tests_font(no_act_tests) = Range("M" & i).Font.FontStyle
        Range("M" & i).Select
        'tests_comments(no_act_tests) = Range("M" & i).SpecialCells(xlCellTypeComments).Select
        tests_comments(no_act_tests) = ActiveCell.Comment.Text
        no_act_tests = no_act_tests + 1
    End If
Next i
no_act_tests = no_act_tests - 1
'ActiveCell.Value = browsers_used(1)


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Creating New Tab~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = tab_name_desk
End With
End With

 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Printing Template~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Worksheets(tab_name_desk)

.Range("A1").Value = "Browser:"
.Range("A2").Value = "Resolution:"
.Range("A3").Value = "Page URL:"
.Range("B3").Value = url_name

'displaying all the tests to be done in the first column
For i = 1 To no_act_tests
    .Range("A" & i + 3).Value = tests_used(i)
    .Range("A" & i + 3).IndentLevel = tests_indent(i)
    .Range("A" & i + 3).Font.FontStyle = tests_font(i)
    'With .Range("A" & i + 3).AddComment
        .Range("A" & i + 3).AddComment.Visible = False
        .Range("A" & i + 3).AddComment = tests_comments(i)
    'End With
Next i

k = 1
For i = 1 To no_act_browsers_desk
    .Cells(1, ((i - 1) * k) + 2).Value = browsers_used_desk(i) 'displaying the browsers
    .Cells(1, ((i - 1) * k) + 2).IndentLevel = browsers_indent_desk(i)
    .Cells(1, ((i - 1) * k) + 2).Font.FontStyle = browsers_font_desk(i)
    .Range(.Cells(1, ((i - 1) * k) + 2), .Cells(1, ((i - 1) * k) + 1 + no_act_res_desk)).Merge
    k = no_act_res_desk
    For j = 1 To no_act_res_desk
        .Cells(2, ((i - 1) * k) + 1 + j).Value = res_used_desk(j) 'displaying the resolutions
        .Cells(2, ((i - 1) * k) + 1 + j).IndentLevel = res_indent_desk(j)
        .Cells(2, ((i - 1) * k) + 1 + j).Font.FontStyle = res_font_desk(j)
    Next j
Next i
End With

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Formatting~~~~~~~~~~~~~~~~~~~~~~~~~~~~

With Sheets(Sheets.Count)

  Cells.Select
  Cells.EntireColumn.AutoFit
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).Select
'------------------------------------Conditional Format 'n'------------------

  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=""n"""
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions(Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions.Count).SetFirstPriority
  With Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 13551615
    .TintAndShade = 0
  End With
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions(1).StopIfTrue = False

'------------------------------------Conditional Format 'y'------------------

  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=""y"""
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions(Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions.Count).SetFirstPriority
  With Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 13561798
    .TintAndShade = 0
  End With
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_desk * no_act_res_desk + 1)).FormatConditions(1).StopIfTrue = False
    '------------------------------------Freezing Panes-------------------------

  With ActiveWindow
    .SplitColumn = 1
    .SplitRow = 3
    .FreezePanes = True
  End With
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Creating New Tab~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = tab_name_mobile
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Printing Template~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Worksheets(tab_name_mobile)

  .Range("A1").Value = "Browser:"
  .Range("A2").Value = "Resolution:"
  .Range("A3").Value = "Page URL:"
  .Range("B3").Value = url_name

  'displaying all the tests to be done in the first column
  For i = 1 To no_act_tests
    .Range("A" & i + 3).Value = tests_used(i)
    .Range("A" & i + 3).IndentLevel = tests_indent(i)
    .Range("A" & i + 3).Font.FontStyle = tests_font(i)
    '.Range("A" & i + 3).AddComment.Text = tests_comments(i)
  Next i

  k = 1
  For i = 1 To no_act_browsers_mobile
    .Cells(1, ((i - 1) * k) + 2).Value = browsers_used_mobile(i) 'displaying the browsers
    .Cells(1, ((i - 1) * k) + 2).IndentLevel = browsers_indent_mobile(i)
    .Cells(1, ((i - 1) * k) + 2).Font.FontStyle = browsers_font_mobile(i)
    .Range(.Cells(1, ((i - 1) * k) + 2), .Cells(1, ((i - 1) * k) + 1 + no_act_res_mobile)).Merge
    k = no_act_res_mobile
    For j = 1 To no_act_res_mobile
        .Cells(2, ((i - 1) * k) + 1 + j).Value = res_used_mobile(j) 'displaying the resolutions
        .Cells(2, ((i - 1) * k) + 1 + j).IndentLevel = res_indent_mobile(j)
        .Cells(2, ((i - 1) * k) + 1 + j).Font.FontStyle = res_font_mobile(j)
    Next j
  Next i
End With

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Formatting~~~~~~~~~~~~~~~~~~~~~~~~~~~~

With Sheets(Sheets.Count)

  Cells.Select
  Cells.EntireColumn.AutoFit
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).Select
'------------------------------------Conditional Format 'n'------------------

  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=""n"""
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions(Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions.Count).SetFirstPriority
  With Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 13551615
    .TintAndShade = 0
  End With
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions(1).StopIfTrue = False

'------------------------------------Conditional Format 'y'------------------

  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=""y"""
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions(Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions.Count).SetFirstPriority
  With Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 13561798
    .TintAndShade = 0
  End With
  Range("B4", .Cells(3 + no_act_tests, no_act_browsers_mobile * no_act_res_mobile + 1)).FormatConditions(1).StopIfTrue = False
'------------------------------------Freezing Panes-------------------------

  With ActiveWindow
    .SplitColumn = 1
    .SplitRow = 3
    .FreezePanes = True
  End With

  Application.ScreenUpdating = True
End With

End Sub

非常感谢任何帮助。如果还有什么我应该补充的，请告诉我。

如何在变量中保存单元格注释并将其应用于其他单元格

0 个答案: