Поиск значений в нескольких столбцах с помощью VBA

Question

Я относительно новичок в excel vba, но я ищу несколько советов о создании макроса, который я могу запустить по нескольким листам в книге.

Совет, который я ищу, - это взять 3 столбца, где я могу найти определенные значения в этих столбцах. Если строка имеет значение в каждом из трех столбцов, которые удовлетворяются, чтобы сохранить эти строки вместе со всеми заголовками столбцов в новый рабочий лист в той же книге. Итак, если у меня есть 10 рабочих листов в моей книге и запустите макрос, мне нужно закончить 20 рабочих листов.

Может ли кто-нибудь мне помочь?

Answer 1

Поскольку вы новичок в VBA, я даю вам код. Господь знает, что я очень помог, когда был новым. Проверь это. Я не уверен, как вы собираетесь проходить, какие ценности нужно искать, но это должно дать вам отличное начало.

Sub find3_makesheet() 

Dim strValue As String 
Dim wks As Worksheet 
Dim rng1 As Range, rng2 As Range, rng3 As Range 

strValue = "myValue" 

For Each wks In Worksheets 

    With wks 

     If Not .Columns(1).Find(strValue, lookat:=xlWhole) Is Nothing Then Set rng1 = .Columns(1).Find(strValue, lookat:=xlWhole) 
     If Not .Columns(2).Find(strValue, lookat:=xlWhole) Is Nothing Then Set rng2 = .Columns(2).Find(strValue, lookat:=xlWhole) 
     If Not .Columns(2).Find(strValue, lookat:=xlWhole) Is Nothing Then Set rng3 = .Columns(2).Find(strValue, lookat:=xlWhole) 

     If Not rng1 Is Nothing And Not rng2 Is Nothing And Not rng3 Is Nothing Then 
      ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
      Set wksCopyTo = ActiveSheet 
      .Rows(1).EntireRow.Copy wksCopyTo.Rows(1) 
      rng1.EntireRow.Copy wksCopyTo.Rows(2) 
      rng2.EntireRow.Copy wksCopyTo.Rows(3) 
      rng3.EntireRow.Copy wksCopyTo.Rows(4) 
     End If 

    End With 

    Set rng1 = Nothing 
    Set rng2 = Nothing 
    Set rng3 = Nothing 
Next 

End Sub