[已解决]求助求助，想做一个VBA代码删除部分数据信息

Veeko · 发表于 2015-7-16 15:03

如附件所示，数据样本由序号1至497，日期由1号至20号。我想利用VBA代码，删除范围内的1243,1477,1901,1291,1295,1253,1293,1275,1233 数字。原先使用的都是比较简单的方法，利用替换功能来做。但是现在需要每天出一个这样的表格，需要把上述数字都删掉，工作量太大。看看有啥其他更好的方法....T>T
求助各位大仙！

最佳答案

月排行榜 / 总排行榜

爱疯

2015-7-16 15:57

Sub Click()
Dim A, B, i, j, k
A = Sheets(1).Range("a1").CurrentRegion
B = Sheets(2).Range("a1").CurrentRegion

For i = 2 To UBound(B)
      For j = 2 To UBound(B, 2)
         For k = 1 To UBound(A)
            If InStr(B(i, j), A(k, 1)) Then B(i, j) = VBA.Replace(B(i, j), A(k, 1), "")
         Next k
      Next j
Next i

With Sheets(3)
      .Range("a1").CurrentRegion = ""
      .Range("a1").Resize(i - 1, j - 1) = B
      .Select
End With
End Sub

2015.07.16 原始数据2.rar (81.55 KB, 下载次数: 5)

Excel学徒123 · 发表于 2015-7-16 15:48

每个月都这样的数字？

Veeko · 发表于 2015-7-16 15:52

Excel学徒123 发表于 2015-7-16 15:48
每个月都这样的数字？

实际上，是每天都是这样的数字。

七彩屋 · 发表于 2015-7-16 15:57

Sub 批量替换()
Application.ScreenUpdating = False
Dim x%
Cells.Select
For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
x = Sheets(1).Cells(i, 1)
Selection.Replace What:=x, Replacement:=""
Next
Application.ScreenUpdating = True
End Sub

复制代码

爱疯 · 发表于 2015-7-16 15:57

Sub Click()
Dim A, B, i, j, k
A = Sheets(1).Range("a1").CurrentRegion
B = Sheets(2).Range("a1").CurrentRegion

For i = 2 To UBound(B)
      For j = 2 To UBound(B, 2)
         For k = 1 To UBound(A)
            If InStr(B(i, j), A(k, 1)) Then B(i, j) = VBA.Replace(B(i, j), A(k, 1), "")
         Next k
      Next j
Next i

With Sheets(3)
      .Range("a1").CurrentRegion = ""
      .Range("a1").Resize(i - 1, j - 1) = B
      .Select
End With
End Sub

2015.07.16 原始数据2.rar (81.55 KB, 下载次数: 5)

dachairen · 发表于 2015-7-16 16:09

Sub 删除数字()
Dim arr, x
arr = Application.Transpose(Sheet1.[a1:a9])
For x = 1 To UBound(arr)
Sheet2.UsedRange.Replace arr(x), "", 2
Next
MsgBox "删除完毕！"
End Sub

		自动登录	找回密码
密码			注册

[已解决]求助求助，想做一个VBA代码删除部分数据信息

评分

评分

评分