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

如果您的Source表有第一个标题的riw，您可以使用AutoFilter（）方法仅过滤相关记录并一次性粘贴它们：

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语句，我只看一下A列的前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

Excel VBA-如何提取特定行

2 个答案: