Вложенный цикл do while для цикла поиска по ключевым словам в столбцах, выполняющихся только один раз VBA - PullRequest
Новая
       24

Вложенный цикл do while для цикла поиска по ключевым словам в столбцах, выполняющихся только один раз VBA

0 голосов
/ 11 сентября 2018

Я пытаюсь создать цикл поиска по ключевым словам, который может сканировать рефераты научных статей, которые импортируются в 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

1 Ответ

0 голосов
/ 12 сентября 2018

Попробуйте это: 

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
...