简体   繁体   English

Excel VBA-用文本清除单元格上方和下方的单元格

[英]Excel VBA - clear cells above and below cell with text

I'm looking for some help please with some VBA. 我正在寻找一些VBA的帮助。

Let's say I have a range of cells (B4:B12), so if I input data in a cell within the range I would like to clear all cells in the same range except for the cell in which I inputed the data. 假设我有一个单元格范围(B4:B12),因此,如果我在该范围内的单元格中输入数据,我想清除同一范围内的所有单元格,但我要输入数据的单元格除外。 So that I can only have 1 cell with data in the range. 这样我只能有1个单元格的数据在范围内。

So if B5 had data and I inputed data in B7 then B5 would clear, then if i entered data in B10 then B7 would clear... 因此,如果B5有数据并且我在B7中输入了数据,则B5将清除,然后,如果我在B10中输入了数据,则B7将清除...

I hope there is a solution as I have been trying to find an answer for the past couple of hours. 我希望有一个解决方案,因为我在过去的几个小时中一直在努力寻找答案。

I would do it this way: 我会这样:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Set myRange = Sh.Range("B4:B12")

'set the current cell/address/value so we don't lose them when the range is cleared
Set cell = Sh.Range(Target.address)    
value = Target

'disable/enable so this isn't called every time a cell is cleared
'clear the range then reset the to entered value
If Not Intersect(Target, myRange) Is Nothing Then
    Application.EnableEvents = False
    myRange.Clear
    cell.value = value
    Application.EnableEvents = True
End If

End Sub

Or you could use worksheet event to bevplaced in the relevant worksheet code pane 或者您可以使用工作表事件将其放置在相关的工作表代码窗格中

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myVal As Variant

    With Range("B4:B12") ‘reference your range
        If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then ‘ if changed range is one cell within the referenced one
            myVal = Target.Value ‘store changed cell value
            Application.EnableEvents = False
            .ClearContents ‘ clear the content of referenced range
            Target.Value = myVal ‘ write changed cell value back
            Application.EnableEvents = True
        End If
    End With 
End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM