可否簡化 VBA 語法

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 231
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

12^#

發表於 2017-2-8 15:59 | 只看該作者

回復 6# 准提部林

Dear ikboy / 准提部林 / ML089

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

028-01.zip (10.39 KB)

Just do it.

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 231
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

13^#

發表於 2017-2-8 16:28 | 只看該作者

回復 11# ML089

A欄空白時若H欄有資料不刪除嗎? --> A欄空白，一律要刪除

Just do it.

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

14^#

發表於 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

中學生 Rank: 2

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

2016猴年全勤獎章

15^#

發表於 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")
Myr = IIf([a65536].End(3).Row > [h65536].End(3).Row, [a65536].End(3).Row, [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

複製代碼

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 231
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

16^#

發表於 2017-2-8 17:32 | 只看該作者

回復 14# 准提部林

Dear 准提部林
測試成功
請問哪一個語法是刪除A欄空白列阿?

Just do it.

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

17^#

發表於 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

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

18^#

發表於 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

[b]Kubi[/b]

版主 Rank: 7 Rank: 7 Rank: 7

ML089

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

19^#

發表於 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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 231
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

20^#

發表於 2017-2-8 21:02 | 只看該作者

回復 17# 准提部林

了解，感謝您的回覆!

Just do it.