跟据B列(物料编码)内容判断,比方说如果新增加在B8单元格编码与之前B2单元格相同编码时,则自动删除B2所在的行(第2行),求高手给VBA代码,最好注释每句代码的意思,谢谢!目的:每个代编只有一条记录,而且是最新记录。
进入vba编辑器,双击如图所示,进入ThisWorkbook代码编辑窗口,复制下面代码
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)Workbook_SheetChange为工作薄内部事件,当用户更改工作表中的单元格或者外部链接引起单元格的更改时,产生此事件。参数Target为发生更改的区域。
使用excel内置函数 CountIf 计算区域中满足给定条件的单元格的个数。delete方法删除刚刚修改的范围,xlShiftUp指定删除单元格时替补单元格的移位方式为向上。
追问代码简洁,但只能删除新增的B列单元格的内容,可我要的是删除旧的数据,保留新数据,另外该代码不能删除目的数据的整行,高手你修改一下看如何?
追答Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)你好,上面代码只能在表格手动键入内容时能够达到删除旧数据的目的,而使用粘贴(整行数据同时粘贴)方法时代码不能执行,再修改一下如何?
追答应该可以了。如果搞定了请一定要加分哦
将代码放入 sheet1(sheet1)中JMEYCN已经截图了
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
a = Target.Row - 1 '得到填入数据的行数的上一行
If Target.Count > 1 Or Target.Column <> 2 Then '如果改变的单元格大于1或者列数不是2那么退出程序
Exit Sub
Else
If Sheets(1).Range("b1: b" & a).Find(Target.Value) Is Nothing Then '查找填入行以上有没有和该单元格相同的值,没有则退出程序否则,将找到的行删除,下行上移
Exit Sub
Else
Sheets(1).Range("b1: b" & a).Find(Target.Value).EntireRow.Delete xlShiftUp
End If
End If
End Sub
试下吧 不行的话 HI我
附件 excel 2010版本
思路清晰,但代码不能达到预期目的,请高手修改一下如何。
追答Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
a = Target.Row - 1 '得到填入数据的行数的上一行
If Target.Count > 1 Or Target.Column <> 2 Or Target.Row <= 1 Then '如果改变的单元格大于1或者列数不是2那么退出程序
Exit Sub
Else
If Sheets(1).Range("b1: b" & a).Find(Target.Value) Is Nothing Then '查找填入行以上有没有和该单元格相同的值,没有则退出程序否则,将找到的行删除,下行上移
Exit Sub
Else
Sheets(1).Range("b1: b" & a).Find(Target.Value).EntireRow.Delete xlShiftUp
End If
End If
End Sub
附件可以运行的 ,你再试试 excel 2010版本的
不知哪里出了问题,代码没有任何动作
追答放入 sheet......XXX......中,例如(sheet1或sheet2.........)