时间戳

首页 > 解决方案 > 嵌套do while循环在for循环中仅在VBA中执行一次的列中的关键字搜索

excel - 嵌套do while循环在for循环中仅在VBA中执行一次的列中的关键字搜索

问题描述

我正在尝试创建一个关键字搜索循环，该循环可以扫描使用不同程序导入 excel 的研究论文摘要。这些研究论文的摘要都在 K 列中，当我运行代码时，我只会将关键字（0）复制到另一张表中。我重新排列了关键字并证明搜索确实适用于第一次再现，但 for 循环本身不执行，或者 while 循环在第一次执行后结束。

 Dim LSearchRow As Integer
       Dim LCopyToRow As Integer
        Dim keyword(3) As String
        Dim i As Integer

   On Error GoTo Err_Execute
   LSearchRow = 2
   LCopyToRow = 2

    keyword(0) = "financial crisis"
    keyword(1) = "credit default swap"
    keyword(2) = "market manipulation"
    keyword(3) = "financial crisis"
    Sheets("Research").Select

   For i = LBound(keyword) To UBound(keyword)
       While Len(Range("K" & CStr(LSearchRow)).Value) > 0
            If InStr(1, Range("K" & CStr(LSearchRow)).Value, keyword(i)) > 0 Then

             'Select row in Sheet to copy
             Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
             Selection.Copy

             'Paste row into Sheet in next row
             Sheets("Research").Select
             Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
             ActiveSheet.Paste

             'Move counter to next row
             LCopyToRow = LCopyToRow + 1

             'Go back to Sheet2 to  

             Sheets("Research").Select

          End If
          LSearchRow = LSearchRow + 1
       Wend
   Next i

标签： excelvbafor-loopdo-while

解决方案

尝试这个：

Dim rwSearch As Range
Dim rwCopy As Range
Dim keyword 'variant
Dim i As Long, k

Set rwSearch = Sheets("Research").Rows(2)
Set rwCopy = Sheets("Results").Rows(2)   '<< not "Research" ?

keyword = Array("financial crisis", "credit default swap", _
               "market manipulation", "financial crisis")

Do While Len(rwSearch.Cells(1, "K")) > 0
    k = rwSearch.Cells(1, "K").Value
    For i = LBound(keyword) To UBound(keyword)
        If InStr(1, k, keyword(i)) > 0 Then
            rwSearch.Copy rwCopy
            Set rwCopy = rwCopy.Offset(1, 0)
            Exit For '<<< already copied this row
        End If
    Next i
    Set rwSearch = rwSearch.Offset(1, 0)
Loop

推荐阅读