Option Explicit
Sub 发票号查询()
Application.ScreenUpdating = False '关闭屏幕刷新
Dim j&, m&, k&, i&
j = Sheets("资料信息").[A65536].End(3).Row '计算资料信息表数据总行数
m = Sheets("同一发票号下商品信息").[A65536].End(3).Row '计算同一发票号下商品信息表数据总行数
Sheets("同一发票号下商品信息").Rows("3:" & m + 1).Delete '删除同一发票号下商品信息表第3到最后一个有数据的行
k = 2 '计数器k初始化为2 假设表头有2行,提取的数据copy的位置从第3行开始
For i = 2 To j 'i从第2行循环到资料信息表的最后一行
If Sheets("资料信息").Cells(i, "x") = Sheets("同一发票号下商品信息").Range("B1") Then '如果资料信息表的第i行第x列的值与同一发票号下商品信息表的B1单元格数据相同
k = k + 1 '计数器k的值+1
Sheets("资料信息").Rows(i).Copy Sheets("同一发票号下商品信息").Range("A" & k) '资料信息表第i行复制到同一发票号下商品信息表的A & k单元格 k为计数器的当前值,例如k=3就是A3单元格
End If
Next
[B1].Select
Application.ScreenUpdating = True '恢复屏幕刷新
End Sub
问题是 你要 怎么复制,
比如你修改 B1 发票号, 而 Sheet2 原有内容是 清除掉,只显示新的发票号内容,
还是 在 原有内容 下面接着添加 ?
需要写 发 文件 1052974911@qq.com ,只留这2个Sheet 即可