[英]Excel VBA-How to Extract Specific Rows
I have multiple "Rooms" in an excel spread sheet and would like to extract the Room, Name, Laptops, Make and Manager while excluding Faculty and Budget. 我在一个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
I am trying to extract all the data I require by modifying the following code but am having difficulty in getting the data in the same order as it is in the sample. 我试图通过修改以下代码来提取我需要的所有数据,但是很难以与示例中相同的顺序来获取数据。
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
Thank you in advance for your help. 预先感谢您的帮助。
Provided your Source sheet has a first riw for headers, you could use AutoFilter() method to filter only relevant records and paste them in one shot: 如果您的“源”工作表具有首个标题标题,则可以使用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
The following change to your code should do it: 对代码进行以下更改即可:
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
I use a Select Case
statement to save having to write a slightly longer If
statement, and I just look at the first 4 characters of column A so that it handles Room x#
type cells. 我使用
Select Case
语句来省去编写稍长的If
语句的麻烦,而我只是查看A列的前4个字符,以便它处理Room x#
类型的单元格。
If you needed blank rows after most of the values (except for "Room"), I would suggest a slight rework of my code above: 如果您需要在大多数值之后添加空白行(“ Room”除外),那么我建议对上面的代码进行一些修改:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.