trantuonganh2008
Thành viên thường trực
- Tham gia
- 8/11/08
- Bài viết
- 305
- Được thích
- 53
Mình vừa sưu tầm đoạn code này. Cho mình hỏi bây giờ muốn xóa những dòng có chữ "giảm giá 15" thì phải sửa như thế nào? Nhờ các cao thủ ra tay! Cám ơn nhiều!
Mã:
[B]Sub DeleteRowsSecondFastest()[/B] Dim rTable As Range Dim rCol As Range, rCell As Range Dim lCol As Long Dim xlCalc As XlCalculation Dim vCriteria On Error Resume Next 'Determine the table range With Selection If .Cells.Count > 1 Then Set rTable = Selection Else Set rTable = .CurrentRegion On Error GoTo 0 End If End With 'Determin if table range is valid If rTable Is Nothing Or rTable.Cells.Count = 1 Or WorksheetFunction.CountA(rTable) < 2 Then MsgBox "Could not determine you table range.", vbCritical, "Ozgrid.com" Exit Sub End If 'Get the criteria in the form of text or number. vCriteria = Application.InputBox(Prompt:="Type in the criteria that macthing rows should be deleted. " _ & "If the criteria is in a cell, point to the cell with your mouse pointer", _ Title:="CONDITIONAL ROW DELETION CRITERIA", Type:=1 + 2) 'Go no further if they Cancel. If vCriteria = "False" Then Exit Sub 'Get the relative column number where the criteria should be found lCol = Application.InputBox(Prompt:="Type in the relative number of the column where " _ & "the criteria can be found.", Title:="CONDITIONAL ROW DELETION COLUMN NUMBER", Type:=1) 'Cancelled If lCol = 0 Then Exit Sub 'Set rCol to the column where criteria should be found Set rCol = rTable.Columns(lCol) 'Set rCell to the first data cell in rCol Set rCell = rCol.Cells(2, 1) 'Store current Calculation then switch to manual. xlCalc = Application.Calculation Application.Calculation = xlCalculationManual 'Loop and delete as many times as vCriteria exists in rCol For lCol = 1 To WorksheetFunction.CountIf(rCol, vCriteria) Set rCell = rCol.Find(What:=vCriteria, After:=rCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Offset(-1, 0) rCell.Offset(1, 0).EntireRow.Delete Next lCol 'Put back calculation to how it was. Application.Calculation = xlCalc On Error GoTo 0 [B]End Sub[/B]
Lần chỉnh sửa cuối:
