在标题中搜索关键字

时间:2015-04-02 07:13:35

标签: excel vba excel-vba

我使用以下代码在具有标题的单元格中搜索一组关键字。在运行代码时,我遇到“运行时错误13”在 b = cell.Value 行上键入不匹配。

Application.ScreenUpdating = False
Dim col As Range, cell1 As Range, a As String, b As String, i As Integer
Set col = Range("KW[KW1]")
Dim target, cell As Range
Sheets("Data").Select
Set target = Range(Range("B1"), Range("B65536").End(xlUp))
Dim term, tag As String
    For Each cell1 In col
    a = cell1.Value

    term = a
    tag = a

        For Each cell In target
           b = cell.Value
           ' If InStr(1, " " & cell & " ", " " & term & " ", 1) Then
          If Module1.ExactWordInString(b, a) Then
                For i = 1 To 15
                    If cell.Offset(0, i).Value = "" Then
                    cell.Offset(0, i).Value = tag
                    Exit For
                    End If
                Next i

        End If

        Next cell
    Next cell1
     Application.ScreenUpdating = True

然而,如果我们在一列中有1000个倾斜,它的运行将非常完美,但我希望运行此代码的范围可达50,000到200,000。请帮帮我。

1 个答案:

答案 0 :(得分:1)

试试这个,你没有将目标声明为范围,可能就是它。

BTW,比较字符串VBA是区分大小写的,所以如果你只想比较内容,请尝试使用Lcase()!

Application.ScreenUpdating = False

Dim target  As Range, cell As Range
Dim term As String, tag As String
Dim col As Range, cell1 As Range, a As String, b As String, i As Integer

Sheets("Data").Select
Set col = Range("KW[KW1]")
Set target = Range(Range("B1"), Range("B65536").End(xlUp))


For Each cell1 In col
    a = Cstr(cell1.Value)
    term = a
    tag = a
    For Each cell In target
        b = Cstr(cell.Value)
        'If InStr(1, " " & cell & " ", " " & term & " ", 1) Then
        If Module1.ExactWordInString(b, a) Then
            For i = 1 To 15
                If cell.Offset(0, i).Value = "" Then
                cell.Offset(0, i).Value = tag
                Exit For
                End If
            Next i
        End If
    Next cell
Next cell1

Application.ScreenUpdating = True