Board logo

標題: VBA程式是否可以簡化(刪除A欄指定字元) [打印本頁]

作者: jsc0518    時間: 2017-11-14 12:57     標題: VBA程式是否可以簡化(刪除A欄指定字元)

親愛的先進,
我的VBA語法如下,是否可以簡化,最主要都是在A欄位有出現關鍵字要刪除以及只要是空白就刪除
*空白、公司、單別:、日期*、產品大類:、核准*、合計*、總計*



Sub Step1()
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

Sub Step2()
Dim yy
yy = "公司"
For i = [a65536].End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Rows(i), yy) > 0 Then Rows(i).Delete
Next i
End Sub

Sub Step3()
'A攔下移除"單別:"
Dim yy
yy = "單別:"
For i = [a65536].End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Rows(i), yy) > 0 Then Rows(i).Delete
Next i
End Sub

Sub Step4()
'A攔下移除"日期*"
Set a = Columns("A").Find("日期*")
Do Until a Is Nothing
a.EntireRow.Delete
Set a = Columns("A").Find("日期*")
Loop
End Sub


Sub Step5()
'A攔下移除"產品大類:"
Dim yy
yy = "產品大類:"
For i = [a65536].End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Rows(i), yy) > 0 Then Rows(i).Delete
Next i
End Sub

Sub Step6()
'A攔下移除"核准*"
Set a = Columns("A").Find("核准*")
Do Until a Is Nothing
a.EntireRow.Delete
Set a = Columns("A").Find("核准*")
Loop
End Sub

Sub Step7()
'A攔下移除"合計*"
Set a = Columns("A").Find("合計*")
Do Until a Is Nothing
a.EntireRow.Delete
Set a = Columns("A").Find("合計*")
Loop
End Sub

Sub Step8()
'A攔下移除"總計*"
Set a = Columns("A").Find("總計*")
Do Until a Is Nothing
a.EntireRow.Delete
Set a = Columns("A").Find("總計*")
Loop
End Sub
作者: ikboy    時間: 2017-11-14 14:34

回復 1# jsc0518
  1. Sub zz()
  2. Dim reg As Object, a, rng As Range, z&
  3. a = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).Value
  4. z = UBound(a)
  5. Set rng = Rows(z + 1)
  6. Set reg = CreateObject("vbscript.regexp")
  7. With reg
  8.     .Pattern = "空白|公司|單別:|日期|產品大類:|核准|合計|總計"
  9.     For i = 1 To z
  10.         If Len(a(i, 1)) = 0 Or .test(a(i, 1)) Then
  11.             Set rng = Union(rng, Rows(i))
  12.         End If
  13.     Next
  14. End With
  15. rng.Delete
  16. Set rng = Nothing
  17. End Sub
複製代碼

作者: jsc0518    時間: 2017-11-14 15:07

回復 2# ikboy
大感激,測試OK
謝謝你的幫忙!




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)