1

我需要帮助创建一个宏,当站在单元格 A 中时,它会删除我在下面标记为 X 的单元格中的值(留下标记为 O 的单元格)。实际的单元格可以包含任何值。

A X X X
X O X X
X X O X
X X X O

这可能吗?

4

2 回答 2

4

试试这个代码:

Sub go_sub()

    Dim tmpRNG As Range
    Set tmpRNG = ActiveCell.CurrentRegion 'or you could set other range definition here, like Range("A1:d4")

    Dim cell As Range
    For Each cell In tmpRNG
        If cell.Row <> cell.Column Then cell.ClearContents
    Next cell
End Sub

编辑上面的代码适用于从单元格 A1 开始的当前区域。

以下代码适用于任何选定区域:

Sub go_sub()

    Dim tmpRNG As Range
    Set tmpRNG = Selection
    Dim tmpOff As Long

        tmpOff = tmpRNG.Row - tmpRNG.Column

    Dim cell As Range
    For Each cell In tmpRNG '.Cells
        If cell.Row - tmpOff <> cell.Column Then cell.ClearContents
    Next cell
End Sub

一个提示:如果你有一个大的关闭屏幕更新的工作,也可能关闭事件。

于 2013-04-17T10:17:16.520 回答
2

以下将采用您当前的单元格并删除除对角线以外的所有单元格,选择左上角的单元格,所有对角线都将保留......但我喜欢 KazJaw 的回答。

Sub go_sub()

'get the range from current cell to the end 
Lastrow = ActiveSheet.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Lastcol = ActiveSheet.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
Set myRange = ActiveSheet.Range(Selection, ActiveSheet.Cells(Lastrow, Lastcol))

'set the next cell to keep as current one
Set Nextcell = selection

'cycle throug all cells in the range
For Each cel In  myRange

    'if the cell is to be kept?
    if cel.address = nextcell.address then
        'Reset the next cell to save BUT DONE CLEAR THECURRENT CELL
        set Nextcell = Nextcell.offset(1,1)
    Else
        'clear current cell if not to be saved
        Cel.clearcontents
    End if
Next
End Sub

前:

前

后:

后

于 2013-04-17T12:49:10.973 回答