若只檢查A欄的內容,參考如下:
Sub zz2()
Dim T$, xR As Range, xE As Range
T = "_TPD_TPD-both_TPD-viewing_GSA_" '將索引值用"_"連接
Set xE = [A65536].End(xlUp)(2) '設A欄最後一格的下一格為 xE
For Each xR In Range([A1], xE(0))
If xR = "" Or InStr(T, "_" & xR & "_") Then Set xE = Union(xE, xR)
Next
xE.EntireRow.Delete
End Sub
Sorry 沒測試, 己更正:
Sub zz()
Application.ScreenUpdating = 0
Dim x(), rng As Range, ar, Myr&
x = Array("TPD", "TPD-both", "TPD-viewing", "GSA")
Myr = [a65536].End(3).Row
ar = Range("a1:a" & Myr)
Set rng = Cells(Myr + 1, 1)
For i = 1 To UBound(ar)
If Len(ar(i, 1)) = 0 Then
Set rng = Union(rng, Cells(i, 1))
Else
For j = 0 To UBound(x)
If InStr(ar(i, 1), x(j)) Then Set rng = Union(rng, Cells(i, 1))
Next
End if
Next
rng.EntireRow.Delete
Application.ScreenUpdating = 1
End Sub作者: jsc0518 時間: 2017-2-8 12:22
Sub ex()
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
For Each x In Array("", "TPD", "TPD-both", "TPD-viewing", "GSA")
If Cells(i, 1) = "" And Cells(i, "H") <> "" Then Exit For
If Cells(i, 1) = x Then Cells(i, 1).EntireRow.Delete
Next
Next
End Sub作者: jsc0518 時間: 2017-2-8 15:59
Sub zz2()
Dim T$, xR As Range, xE As Range, R&
T = "_TPD_TPD-both_TPD-viewing_GSA_" R = Range([A1], ActiveSheet.UsedRange).Rows.Count
Set xE = Range("A" & R + 1)
For Each xR In Range([A1], xE(0))
If xR = "" Or InStr(T, "_" & xR & "_") Then Set xE = Union(xE, xR)
Next
xE.EntireRow.Delete
End Sub作者: ikboy 時間: 2017-2-8 17:01
其實准提部林大的已解決了, 這衹是另一方法:
Sub zz()
Application.ScreenUpdating = 0
Dim x(), rng As Range, ar, Myr&
x = Array("TPD", "TPD-both", "TPD-viewing", "GSA")
If xR = "" Or InStr(T, "_" & xR & "_") Then Set xE = Union(xE, xR)
就已包含"空白"及"關鍵字",
真正問題是, H欄最後一格與A欄不一致(較多),
所以只用A欄去檢測最後一格, 就漏了H欄,
用UsedRange可以包含所有已使用區塊,
但若前幾列是完全空白, 將漏抓這前幾列,
故, 用 Range([A1], UsedRange) 來函蓋整個區塊!作者: Kubi 時間: 2017-2-8 20:41
不用範圍物件變數,應可加快執行速度。
Sub test()
Dim d As Object
Dim arr
st = Timer
Set d = CreateObject("Scripting.Dictionary")
For Each x In Split("TPD.TPD-both.TPD-viewing.GSA", ".")
d(x) = ""
Next x
arr = Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
For i = 1 To UBound(arr)
If d.exists(arr(i, 1)) Then arr(i, 1) = ""
Next i
[A1].Resize(UBound(arr), 1) = arr
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set d = Nothing
arr = ""
MsgBox Format(Timer - st, "0.0秒")
End Sub作者: ML089 時間: 2017-2-8 20:49
Sub ex()
For i = Range([A1], ActiveSheet.UsedRange).Rows.Count To 1 Step -1
For Each x In Array("", "TPD", "TPD-both", "TPD-viewing", "GSA")
If Cells(i, 1) = x Then Cells(i, 1).EntireRow.Delete
Next
Next
End Sub作者: jsc0518 時間: 2017-2-8 21:02