Экземпляр макросов для удаления макросов Excel

Question

Мне нужна помощь в создании макроса, который при стоянии в ячейке A удаляет значение в ячейках, которые я обозначил X ниже (оставляя ячейки с пометкой O). Фактические ячейки могут содержать любое значение.

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

Возможно ли это?

Answer 1

Попробуйте этот код:

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 

EDIT Код выше работает для текущей области, которая начинается в ячейке 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 

Один совета: если у вас есть большое это делает работу с выключателем от обновления экрана, возможно, отключить события тоже.

Answer 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 

До:

После: