Excel VBA – 如何提取特定的行
我有一个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
预先感谢您的帮助。
如果您的源代码表第一次使用标题，则可以使用AutoFilter（）方法仅筛选相关logging并将其粘贴一次：
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
以下更改为您的代码应该这样做：
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#types的单元格。
如果在大部分值（除了“房间”）之后需要空白行，我会build议稍微修改一下上面的代码：
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