作者windknife18 (windknife18)
看板Office
標題Re: [問題] excel vba 刪除問題
時間Sun May 13 16:10:28 2012
修改了一下, 只檢查 A 欄的資料, 去進行刪除, 要刪除的字串可以無限新增
Option Explicit
Sub test()
Dim myRng As Range
Dim myUnion As Range
Dim i As Boolean
On Error Resume Next
For Each myRng In ActiveSheet.Range("A1:A" & _
ActiveSheet.UsedRange.Rows.Count)
If ff(myRng, "A", "B", "C", "D", "12") Then
If i Then
Set myUnion = Application.Union(myUnion, myRng.EntireRow)
Else
Set myUnion = myRng.EntireRow: i = True
End If
End If
Next
myUnion.Delete
End Sub
Function ff(R As Variant, ParamArray X()) As Boolean
Dim i As Integer
Dim b As Boolean
b = False
For i = 0 To UBound(X)
If IsNumeric(Application.Find(X(i), R)) Then
ff = True
Exit Function
End If
Next i
ff = b
End Function
※ 引述《windknife18 (windknife18)》之銘言:
: Option Explicit
: Sub test()
: Dim myRng As Range
: Dim myUnion As Range
: Dim i As Boolean
: On Error Resume Next
: For Each myRng In ActiveSheet.UsedRange
: If ff("ABCD", myRng) Then
: If i Then
: Set myUnion = Application.Union(myUnion, myRng.EntireRow)
: Else
: Set myUnion = myRng.EntireRow: i = True
: End If
: End If
: Next
: myUnion.Delete
: End Sub
: Function ff(X As Variant, R As Variant) As Boolean
: Dim i As Integer
: Dim b As Boolean
: b = False
: For i = 1 To Len(X)
: If IsNumeric(Application.Find(Mid(X, i, 1), R)) Then
: ff = True
: Exit Function
: End If
: Next i
: ff = b
: End Function
: ※ 引述《HILLFLY (假如時光倒流)》之銘言:
: : 軟體:
: : 2003
: : 版本:
: : 剛剛有爬文 想要刪除儲存格的資料
: : 假設資料有
: : A
: : B
: : C
: : D
: : E X
: : E X
: : E X
: : E X
: : E X
: : A
: : B
: : C
: : D
: : 想要把資料中 ABCD一整行全部刪除
: : 變成
: : E X
: : E X
: : E X
: : E X
: : E X
: : 想用EXCEL VBA做
: : 剛剛有爬文
: : Sub test()
: : Dim myRng As Range
: : Dim myUnion As Range
: : Dim i As Boolean
: : On Error Resume Next
: : For Each myRng In ActiveSheet.UsedRange
: : If IsNumeric(Application.Find("CBO", myRng)) Then
: : If i Then
: : Set myUnion = Application.Union(myUnion, myRng.EntireRow)
: : Else
: : Set myUnion = myRng.EntireRow: i = True
: : End If
: : End If
: : Next
: : myUnion.Delete
: : End Sub
: : 修改成
: : Sub test()
: : Dim myRng As Range
: : Dim myUnion As Range
: : Dim i As Boolean
: : On Error Resume Next
: : For Each myRng In ActiveSheet.UsedRange
: : If IsNumeric(Application.Find("A","B","C","D", myRng)) Then
: : If i Then
: : Set myUnion = Application.Union(myUnion, myRng.EntireRow)
: : Else
: : Set myUnion = myRng.EntireRow: i = True
: : End If
: : End If
: : Next
: : myUnion.Delete
: : End Sub
: : 這樣子不行耶..... = =
: : 可以有大大跟我說哪裡出錯了嗎?
: : 感恩....Orz
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 140.131.84.231
推 HILLFLY:感謝!很順很快比我原來用的方式..... 05/13 16:29
→ HILLFLY:^__^ 05/13 16:30
推 topgunguy:推,消化中 05/13 16:52
推 zchien:高手... 05/16 05:47