Excel：VBAmacros从包含string的单元格中提取关键字

我是新的Excelmacros和VBA，并面临以下问题：

（1）我有一个大约有50,000行11列的数据集。

（2）我需要从表格中提取行，基于某个关键字 – 匹配特定列中的string。

（3）我从另一个堆栈溢出问题有下面的代码：

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）当被search的列的单元格中有“YourCriteria”作为唯一的条目时，这个效果很好。

（5）但是，在我的数据中，我有一些stringembedded了“YourCriteria”

例如：“YourCriteria”=“球”，特定栏中的单元格包含“狗玩球”，“球不好”等。

我如何提取包含“YourCriteria”的行？需要对代码进行哪些修改？

谢谢

Answer 1

为了扩大Doug的答案，

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

编辑更改2到你想要查找的列号（C = 3，D = 4，…）。 你也可以使用Columns("B").Column像你这样的Columns("B").Column有，如果你更舒服。

我发现If InStr()>0比If Instr()更可靠，因为InStr有很多返回值选项 。

一般认为，为了避免将来出现问题 – 而不是转换工作表，请明确指出您的意思。 例子（并非所有代码都显示）：

 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

在VBA中有一个内置的运算符： Like 。 你可以用这个replace当前的testing：

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

Answer 3

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

参数或参数

开始

可选的。 这是search的起始位置。 如果省略此参数，search将从位置1开始。

串

要在其中search的string。

子

您想要查找的子string。

比较可选。 这是执行比较的types。 它可以是以下值之一：

VBA常量值说明vbUseCompareOption -1使用选项比较vbBinaryCompare 0二进制比较vbTextCompare 1文本比较

来自http://www.techonthenet.com/excel/formulas/instr.php

Answer 4

最快的方法是：

• 将filter应用于数据
• 设置范围variables= .SpecialCells（xlCellTypeVisible）
• 使用range.Copy Sheets("Sheet2").Range("A1")将数据直接复制到Sheet2

     Sub DoIt（）

         Dim SearchRange As Range
         Sheet（“Sheet1”）。UsedRange.AutoFilter Field：= 2，Criteria1：=“= * Ball *”，_
            运营商：= xlAnd

         Set SearchRange = Sheets（“Sheet1”）。UsedRange.SpecialCells（xlCellTypeVisible）

        如果不是SearchRange是没有的话

             SearchRange.Copy表（“Sheet2”）。范围（“A1”）

        万一

    结束小组