Board logo

標題: 可否簡化 VBA 語法 [打印本頁]

作者: jsc0518    時間: 2017-2-7 14:16     標題: 可否簡化 VBA 語法

大家好,我寫一串語法
但自覺得過程太冗長,是否可以簡化程式語法


條件1.在A欄位,只要出現是"空白",就整列移除
條件2.在A欄位,只要出現這些英文,就整列移除 : TPD . TPD-both . TPD-viewing . GSA

Sub Step1()

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

Sub Step2()

Dim yy
yy = "TPD"
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()

Dim yy
yy = "TPD-both"
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()

Dim yy
yy = "TPD-viewing"
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 Step5()

Dim yy
yy = "GSA"
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

在麻煩各位先進!
作者: ikboy    時間: 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
作者: ML089    時間: 2017-2-8 09:58

  1. Sub ex()
  2.     For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
  3.         For Each x In Array("", "TPD", "TPD-both", "TPD-viewing", "GSA")
  4.             If Cells(i, 1) = x Then Cells(i, 1).EntireRow.Delete
  5.         Next
  6.     Next
  7. End Sub
複製代碼

作者: jsc0518    時間: 2017-2-8 10:00

回復 2# ikboy

您好,感謝回覆,但在執行過程中會發生錯誤訊息,如下圖


[attach]26551[/attach]

[attach]26552[/attach]

在麻煩您了!
作者: jsc0518    時間: 2017-2-8 10:07

回復 3# ML089

ML089
感謝您的提供,測試成功,謝謝您!
作者: 准提部林    時間: 2017-2-8 10:17

本帖最後由 准提部林 於 2017-2-8 10:19 編輯

若只檢查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

資料多的話,檢查完畢再一次刪,速度較快∼∼
作者: ikboy    時間: 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
作者: jsc0518    時間: 2017-2-8 12:22

回復 7# ikboy


您好,我有測試過,但仍有一些問題,若A欄是空白的(我要刪除列),但在H欄有資料(我不需要)
經測試後,它(H爛)的資料仍會存在,並不會因為A欄是空白而刪除整列
作者: jsc0518    時間: 2017-2-8 12:23

回復 3# ML089

您好,我有測試過,但仍有一些問題,若A欄是空白的(我要刪除列),但在H欄有資料(我不需要)
經測試後,它(H爛)的資料仍會存在,並不會因為A欄是空白而刪除整列
作者: jsc0518    時間: 2017-2-8 12:24

回復 6# 准提部林

您好,我有測試過,但仍有一些問題,若A欄是空白的(我要刪除列),但在H欄有資料(我不需要)
經測試後,它(H爛)的資料仍會存在,並不會因為A欄是空白而刪除整列
作者: ML089    時間: 2017-2-8 15:59

本帖最後由 ML089 於 2017-2-8 16:03 編輯

回復 9# jsc0518


A欄空白時若H欄有資料 不刪除嗎?

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

回復 6# 准提部林


Dear ikboy / 准提部林 / ML089

我在H欄有設定資料,但A欄是空白的,若H欄資料是位於最下方時,程式無法刪除該列

[attach]26561[/attach]

[attach]26562[/attach]

[attach]26563[/attach]
作者: jsc0518    時間: 2017-2-8 16:28

回復 11# ML089


A欄空白時若H欄有資料 不刪除嗎?   --> A欄空白,一律要刪除
作者: 准提部林    時間: 2017-2-8 16:40

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

其實准提部林大的已解決了, 這衹是另一方法:
  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
複製代碼

作者: jsc0518    時間: 2017-2-8 17:32

回復 14# 准提部林


Dear 准提部林
測試成功
請問哪一個語法是刪除A欄空白列阿?
作者: 准提部林    時間: 2017-2-8 17:57

回復 16# jsc0518


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

本帖最後由 ML089 於 2017-2-9 14:30 編輯

回復 13# jsc0518

最後一列 Range([A1], ActiveSheet.UsedRange).Rows.Count 參考14樓

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

回復 17# 准提部林


   了解,感謝您的回覆!
作者: jsc0518    時間: 2017-2-9 13:01

回復 18# Kubi


請問
1.這段語法 --> For Each x In Split("TPD.TPD-both.TPD-viewing.GSA", ".")
  內的 "." 是表是甚麼? 是不是移除A欄空白列?

Thanks!
作者: Kubi    時間: 2017-2-10 13:31

回復 21# jsc0518
. 是用於標識子字串邊界的字串字元,以產生各字串所組成的一維陣列。
你也可以隨意定義區隔字串字元,例如改用逗號(,)也可以。
若改成逗號會像如下陳述:
Split("TPD,TPD-both,TPD-viewing,GSA", ",")
作者: jsc0518    時間: 2017-2-10 14:22

回復 22# Kubi

感謝你的教導!




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