Вопрос по vba, excel – Поиск определенного слова и копирование строки на другой лист

0

У меня есть электронная таблица, которая состоит из столбцов от A-P и строк 1 до 2016 (и продолжает расти). Я ищу простой способ поиска в таблице по определенному слову, например, «Gap», и в нем есть строки, содержащие слово «gap». скопирован на лист2. Я хотел бы, чтобы он мог использовать поле, в которое я вставил слово, чтобы я мог искать разные вещи по мере необходимости.

Я не ожидаю, что электронная таблица станет меньше (это список элементов действия, мне нужно его искать, пока он не достигнет пустой строки).

Как я могу это сделать?

Ваш Ответ

1   ответ
1
'all variables must be declared    
Option Explicit
Sub CopyData()

'this variable holds a search phrase, declared as variant as it might be text or number
Dim vSearch As Variant
'these three variables are declared as long, technically the loop might exceed 32k (integer) therefore it is safer to use long
Dim i As Long
Dim k As Long
Dim lRowToCopy As Long

'the macro prompts a user to enter the search phrase
vSearch = InputBox("Search")
'varialbe i initially declared as 1 - macro starts calculations from the 1st row
i = 1
'macro will loop until it finds a row with no records
'I called a standard XLS function COUNTA to count the number of non-blank cells
'if the macro finds a row with no records it quits the loop
Do Until WorksheetFunction.CountA(Sheets("Main").Rows(i)) = 0

 'here I let the macro to continue its run despite a possible errors (explanation below)
  On Error Resume Next
  lRowToCopy = 0
 'if Find method finds no value VBA returns an error, this is why I allowed macro to run despite that. In case of error variable lRowToCopy keeps 0 value
 'if Find method finds a searched value it assigns the row number to var lRowToCopy
  lRowToCopy = Sheets("Main").Rows(i).Find(What:=vSearch, LookIn:=xlValues,     LookAt:=xlPart, SearchOrder:=xlByRows).Row
 'here we allow macro to disiplay error messages
  On Error GoTo 0

 'if var lRowToCopy does not equal to 0 that means a row with a searched value has been found
  If lRowToCopy > 0 Then

    'this loop looks for the first blank row in 2nd sheet, I also used COUNTA to find absolutely empty row
    For k = 1 To Sheets("ToCopy").Rows.Count

      'when the row is found, the macro performs copy-paste operation
      If WorksheetFunction.CountA(Sheets("ToCopy").Rows(k)) = 0 Then

          Sheets("Main").Rows(i).Copy
          Sheets("ToCopy").Select
          Rows(k).Select
          ActiveSheet.Paste
          'do not forget to exit for loop as it will fill all empty rows in 2nd sheet
          Exit For

      End If
    Next k

  End If

i = i + 1
Loop

End Sub
Вы хотите добавить второй ответ с пояснениями к коду? Я знаю, что код выглядит не очень хорошо сейчас, но я думаю, что легче понять его после каждого шага.
Хорошо, я восстановлю его, когда вернусь домой, сейчас я на работе: D
Ваш код был бы великолепен с некоторыми комментариями и пояснениями о том, как его использовать, чтобы ОП (который, кажется, плохо знает VBA) знал, с чего начать.
@MarcinJanowski Я думаю, что JMax подразумевал, что ваш ответ должен содержать объяснение («ответ» на вопрос), а не просто код.
Привет, Марцин, я очень ценю твою помощь! jennifer

Похожие вопросы