[已解决]求助通过VBA删除多余行和列

jiali0208 · 发表于 2016-11-24 13:46

本帖最后由 jiali0208 于 2016-11-25 16:05 编辑

求助:通过VBA删除多余行和列!

最佳答案

爱疯

2016-11-25 09:21

Sub test()
Dim A, B, i, s
Application.ScreenUpdating = False
Sheets(1).UsedRange.Copy
Sheets(3).Select
ActiveSheet.Range("a1").PasteSpecial xlPasteValues
Range("a1").Select
Cells.Replace vbLf, ""
A = ActiveSheet.UsedRange
ReDim B(1 To UBound(A), 1 To 7)

For i = 1 To UBound(A)
      If A(i, 4) <> "" And A(i, 4) <> "报价" Then
         s = s + 1
         B(s, 1) = A(i, 1)
         B(s, 2) = A(i, 4)
         B(s, 3) = A(i, 6)
         B(s, 4) = A(i, 12)
         B(s, 5) = A(i, 13)
         B(s, 6) = A(i, 17)
         B(s, 7) = A(i, 21)
      End If
Next i
Cells.Delete
Range("a1:g1") = Array("产品名称", "报价", "优惠方式", "纸质", "模型", "规格", "备注")
Range("a2").Resize(s, UBound(B, 2)) = B
End Sub

求助通过VBA删除多余行和列2.rar (28.84 KB, 下载次数: 7)

望帝春心 · 发表于 2016-11-24 13:58

感觉用基础操作也可以吧，处理完了代码不一定写好

jiali0208 · 发表于 2016-11-24 21:11

请高手们帮助下，谢谢！

爱疯 · 发表于 2016-11-25 09:21

Sub test()
Dim A, B, i, s
Application.ScreenUpdating = False
Sheets(1).UsedRange.Copy
Sheets(3).Select
ActiveSheet.Range("a1").PasteSpecial xlPasteValues
Range("a1").Select
Cells.Replace vbLf, ""
A = ActiveSheet.UsedRange
ReDim B(1 To UBound(A), 1 To 7)

For i = 1 To UBound(A)
      If A(i, 4) <> "" And A(i, 4) <> "报价" Then
         s = s + 1
         B(s, 1) = A(i, 1)
         B(s, 2) = A(i, 4)
         B(s, 3) = A(i, 6)
         B(s, 4) = A(i, 12)
         B(s, 5) = A(i, 13)
         B(s, 6) = A(i, 17)
         B(s, 7) = A(i, 21)
      End If
Next i
Cells.Delete
Range("a1:g1") = Array("产品名称", "报价", "优惠方式", "纸质", "模型", "规格", "备注")
Range("a2").Resize(s, UBound(B, 2)) = B
End Sub

求助通过VBA删除多余行和列2.rar (28.84 KB, 下载次数: 7)

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