我需要帮助创建一个宏,当站在单元格 A 中时,它会删除我在下面标记为 X 的单元格中的值(留下标记为 O 的单元格)。实际的单元格可以包含任何值。
A X X X
X O X X
X X O X
X X X O
这可能吗?
试试这个代码:
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
一个提示:如果你有一个大的关闭屏幕更新的工作,也可能关闭事件。
以下将采用您当前的单元格并删除除对角线以外的所有单元格,选择左上角的单元格,所有对角线都将保留......但我喜欢 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
前:
后: