返回列表 上一主題 發帖

可否簡化 VBA 語法

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
0  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2025-3-24 

2016猴年全勤獎章
1# 跳轉到 »
發表於 2017-2-8 09:37 | 顯示全部帖子
回復 1# jsc0518


Try this:
  1. Sub zz()
  2. Application.ScreenUpdating = 0
  3. Dim x(), rng As Range, ar, Myr&
  4. x = Array("TPD", "TPD-both", "TPD-viewing", "GSA")
  5. Myr = [a65536].End(3).Row
  6. ar = Range("a1:a" & Myr)
  7. Set rng = Cells(Myr + 1, 1)
  8. For i = 1 To UBound(ar)
  9.     If Len(ar(i, 1)) = 0 Then
  10.         Set rng = Union(rng, Cells(i, 1))
  11.     Else
  12.         For j = 0 To UBound(x)
  13.             If InStr(ar(i, 1), x(j)) Then Set rng = Union(rng, Cells(i, 1))
  14.         Next
  15.     Next
  16. Next
  17. rng.EntireRow.Delete
  18. Application.ScreenUpdating = 1
  19. End Sub
複製代碼
hth
ikboy

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
0  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2025-3-24 

2016猴年全勤獎章
2#
發表於 2017-2-8 11:56 | 顯示全部帖子
回復 4# jsc0518


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

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
0  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2025-3-24 

2016猴年全勤獎章
3#
發表於 2017-2-8 17:01 | 顯示全部帖子
其實准提部林大的已解決了, 這衹是另一方法:
  1. Sub zz()
  2. Application.ScreenUpdating = 0
  3. Dim x(), rng As Range, ar, Myr&
  4. x = Array("TPD", "TPD-both", "TPD-viewing", "GSA")
  5. Myr = IIf([a65536].End(3).Row > [h65536].End(3).Row, [a65536].End(3).Row, [a65536].End(3).Row)
  6. ar = Range("a1:a" & Myr)
  7. Set rng = Cells(Myr + 1, 1)
  8. For i = 1 To UBound(ar)
  9.     If Len(ar(i, 1)) = 0 Then
  10.         Set rng = Union(rng, Cells(i, 1))
  11.     Else
  12.         For j = 0 To UBound(x)
  13.             If InStr(ar(i, 1), x(j)) Then Set rng = Union(rng, Cells(i, 1))
  14.         Next
  15.     End If
  16. Next
  17. rng.EntireRow.Delete
  18. Application.ScreenUpdating = 1
  19. End Sub
複製代碼

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題