Excel：VBA宏从包含字符串的单元格中提取关键字

Question

I am new to Excel Macros and VBA, and am facing the following problem:

(1) I have a data-set which has ~50,000 rows and 11 columns.

(2) I need to extract rows from the sheet, based on a certain keyword - which matches the strings present in a particular column.

(3) I have the following code from another stack overflow question:

Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long

endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1

For r = 1 To endRow 'Loop through sheet1 and search for your criteria

If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found

        'Copy the current row
        Rows(r).Select 
        Selection.Copy

        'Switch to the sheet where you want to paste it & paste
        Sheets("Sheet2").Select
        Rows(pasteRowIndex).Select
        ActiveSheet.Paste

        'Next time you find a match, it will be pasted in a new row
        pasteRowIndex = pasteRowIndex + 1


       'Switch back to your table & continue to search for your criteria
        Sheets("Sheet1").Select  
    End If
Next r
End Sub

(4) This works perfectly fine when the cell of the column being searched has "YourCriteria" as the only entry.

(5) However, in my data I have strings which have the "YourCriteria" embedded in them

For Example: "YourCriteria" = "ball" and the cell(s) in a particular column contain "the dog plays with the ball" , "the ball is bad" etc.

How can I extract the rows containing 'YourCriteria" ? What modification to the code is needed ?

Thanks

Answer 1

To expand on Doug's answer,

If InStr(Cells(r, 2).Value, "YourCriteria")>0 Then 'Found
               '  ^ Column A=1, B=2, ...

Edit Change 2 to whatever column number you want to look in (C=3, D=4, ...). You can also use Columns("B").Column like you had it, if you're more comfortable with that.

I have found If InStr()>0 to be more reliable than If Instr() since InStr has lots of return-value options .

A general thought, to avoid future problems - rather than switching sheets, refer expressly to which sheet you mean. Example (not all code shown):

dim shSource as Sheet
set shSource = ActiveWorkbook.Sheets("Sheet1")
dim shDest as Sheet
set shDest = ActiveWorkbook.Sheets("Sheet2")
...
    If InStr(shSource.Cells(r, 2).Value, "YourCriteria")>0 Then 'Found
        shSource.Rows(r).Copy
        shDest.Rows(pasteRowIndex).Select
        shDest.Paste

Answer 2

There's a built in operator for this in VBA: Like . You can just replace the current test with this:

If Cells(r, Columns("B").Column).Value Like "*YourCriteria*" Then 'Found

Answer 3

InStr( [start], string, substring, [compare] )

Parameters or Arguments

start

Optional. It is the starting position for the search. If this parameter is omitted, the search will begin at position 1.

string

The string to search within.

substring

The substring that you want to find.

compare Optional. It is the type of comparison to perform. It can be one of the following values:

VBA Constant Value Explanation vbUseCompareOption -1 Uses option compare vbBinaryCompare 0 Binary comparison vbTextCompare 1 Textual comparison

borrowed from http://www.techonthenet.com/excel/formulas/instr.php

Answer 4

The fastest way is to:

• Apply a Filter to the data
• Set a range variable = .SpecialCells(xlCellTypeVisible)
• Use range.Copy Sheets("Sheet2").Range("A1") to copy the data straight to Sheet2

Sub DoIt()

        Dim SearchRange As Range
        Sheets("Sheet1").UsedRange.AutoFilter Field:=2, Criteria1:="=*Ball*", _
            Operator:=xlAnd

        Set SearchRange = Sheets("Sheet1").UsedRange.SpecialCells(xlCellTypeVisible)

        If Not SearchRange Is Nothing Then

            SearchRange.Copy Sheets("Sheet2").Range("A1")

        End If

    End Sub