Excel VBA-Как извлечь конкретные строки

Question

У меня есть несколько «комнат» в расширенном листе Excel и вы хотите извлечь комнату, имя, ноутбуки, марку и менеджера, исключая факультет и бюджет.

Room 1# | 
    Name  | Office2 
      | 
    Laptops | 22 
      | 
    Make  | Mac 
      | 
    People | 17 
      | 
    Faculty | Accounts 
      | 
    Manager | John 
      | 
    Budget | xxxxx 
      | 
    Room 2# | 
      | 
    Name  | Office3 
      | 
    Laptops | 22 
      | 
    Make  | HP 
      | 
    People | 20 
      | 
    Faculty | Marketimg 
      | 
    Manager | Jeff 
      | 
    Budget | xxxxx 

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

Sub CopyManager() 
    Dim c As Range 
    Dim j As Integer 
    Dim Source As Worksheet 
    Dim Target As Worksheet 

    ' Change worksheet designations as needed 
    Set Source = ActiveWorkbook.Worksheets("Sheet1") 
    Set Target = ActiveWorkbook.Worksheets("Sheet2") 

    J = 1  ' Start copying to row 1 in target sheet 
    For Each c In Source.Range("A1:A1000") ' Do 1000 rows 
     If c = "Manager" Then 
      Source.Rows(c.Row).Copy Target.Rows(j) 
      j = j + 1 
     End If 
    Next c 
End Sub 

Заранее благодарю вас за помощь.

Answer 1

Предоставлен вашего исходного листа имеет первый RIW для заголовков, вы можете использовать метод Автофильтр() для фильтрации только соответствующие записи и вставить их в одном кадре:

Sub CopyManager() 
    Dim Source As Worksheet 
    Dim Target As Worksheet 
    Dim valsArray As Variant 

    valsArray = Array("Room*", "Name", "Laptops", "Make","Manager") '<--| define your values to be filtered on Source sheet column A 
    ' Change worksheet designations as needed 
    Set Source = ActiveWorkbook.Worksheets("Sheet1") 
    Set Target = ActiveWorkbook.Worksheets("Sheet2") 

    With Source '<--| reference Source sheet 
     With .Range("A1:A1000") '<--| reference its range from A1 to A1000 
      .AutoFilter Field:=1, Criteria1:= valsArray, Operator:=xlFilterValues '<--| filter referenced range on its first column with values stored in valsArray 
      If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell filtered other than 
       .Resize(.Rows.count - 1, 2).Offset(1).SpecialCells(xlCellTypeVisible).Copy Target.Range("A1") '<--|copy filtered cells skipping headers and paste in target sheet from cell A1 
      End If 
     End With 
     .AutoFilterMode= False 
    End With 
End Sub 

Answer 2

Следующие изменения в код должен это сделать:

Sub CopyManager() 
    Dim r As Long 
    Dim j As Long 
    Dim Source As Worksheet 
    Dim Target As Worksheet 

    ' Change worksheet designations as needed 
    Set Source = ActiveWorkbook.Worksheets("Sheet1") 
    Set Target = ActiveWorkbook.Worksheets("Sheet2") 

    J = 1  ' Start copying to row 1 in target sheet 
    For r = 1 To 1000 ' Do 1000 rows 
     Select Case Left(Trim(Source.Cells(r, 1).Value), 4) 
      Case "Mana", _ 
       "Make", _ 
       "Room", _ 
       "Name", _ 
       "Lapt" 
       Source.Rows(r).Copy Target.Rows(j) 
       j = j + 1 
     End Select 
    Next 
End Sub 

Я использую Select Case заявление, чтобы сохранить, чтобы писать немного больше If заявление, и я просто смотрю на первые 4 символов столбца А так что он обрабатывает ячейки типа Room x#.

---

Если вам необходимы пустые строки после большинства значений (за «номер», кроме), я хотел бы предложить небольшую переделку моего кода выше:

Sub CopyManager() 
    Dim r As Long 
    Dim j As Long 
    Dim Source As Worksheet 
    Dim Target As Worksheet 

    ' Change worksheet designations as needed 
    Set Source = ActiveWorkbook.Worksheets("Sheet1") 
    Set Target = ActiveWorkbook.Worksheets("Sheet2") 

    J = 1  ' Start copying to row 1 in target sheet 
    For r = 1 To 1000 ' Do 1000 rows 
     Select Case Left(Trim(Source.Cells(r, 1).Value), 4) 
      Case "Mana", _ 
       "Make", _ 
       "Name", _ 
       "Lapt" 
       Source.Rows(r & ":" & (j + 1)).Copy Target.Rows(j & ":" & (j + 1)) 
       'or, if the "|" in your example is just signifying a new column, use the simpler 
       Source.Rows(r).Copy Target.Rows(j) 

       j = j + 2 
      Case "Room" 
       Source.Rows(r).Copy Target.Rows(j) 
       j = j + 1 
     End Select 
    Next 
End Sub