標題: 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/)