Question

我正在处理一个文件，我和一些同事可以在其中共享“待办事项”并对其发表评论。现在为了删除这些评论，我做了一个“Worksheet_BeforeDoubleClick”事件。双击时，我尝试使用一个宏来选择所有评论，并使用 Selection.Resize 方法删除它们。我想出了这样的代码，但它不起作用：

Dim R_Selection As Range

If ActiveCell.Value = "R" Then
    'Resize to the size of one comment
    ActiveCell.Offset(0, -1).Resize(numRows + 2, numColumns + 2).Select
End If
Set R_Selection = Selection
'Go back to the cell where "R" is found
ActiveCell.Offset(0, 1).Activate

NextReaction:
'Top of each comment is always 4 rows down
If ActiveCell.Offset(4, 0).Value = "R" Then
    
    'Resize to the size of two comments and increase the resize for each found comment
    R_Selection.Resize(numRows + 6, numColumns + 2).Select
    Set R_Selection = Selection
    
    'Go to the next cell where "R" can be found
    ActiveCell.Offset(4, 1).Activate
    
    'Repeat these steps over
    GoTo NextReaction

'If there's no more  "R" to be found, continue to clear the selected range
Else: GoTo ClearRange
End If

我需要，每次找到值“R”时，将选择增加 6 行和 2 列，然后找到下一个“R”再次增加，依此类推，直到找不到更多的“R” .

任何人都可以引导我朝着正确的方向完成这项工作吗？非常感谢你。如果需要更多信息，或者需要编辑问题，请告诉我。

Answer 1

并没有很好地遵循您的逻辑，但在这里可能更合适：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim c As Range, numRows As Long, numCols As Long, rng As Range
    
    Set c = Target.Offset(-1, 0) 'you can use Target (the double-clicked cell)
    Do While c.Value = "R"       'check for R
        numRows = numRows + 6
        numCols = numCols + 2
        Set c = c.Offset(4, 1)   'next cell to check
    Loop
    
    If numRows > 0 Then 'got any R values?
        Set rng = Target.Offset(-1, 0).Resize(numRows, numCols)
        'do something to rng
    End If
End Sub

不需要Select / Activate

每次满足条件时增加 Selection.Resize

1 个答案: