过滤值并将数据复制到新工作表 [英] Filtering values and copying data to new sheet
问题描述
我希望过滤并将数据从主excel电子表格(表1)移动到新表(表2),但到目前为止我发现的所有建议都只涉及过滤一列数据而我想要移动两个。我还需要通过通配符过滤。
I'm looking to filter and move data from a main excel spreadsheet (sheet 1) into a new sheet (sheet 2) but all the advice I've found so far relates to filtering just one column of data and I want to move two. I also need to filter by a wildcard.
我附上了我的工作表1的图像,以及我希望在工作表2中创建的图像。
I've attached an image of my sheet 1, and what I'd ideally want to create in sheet 2.
A列是日期; B栏是动物类型; C列是重量。
Column A is date; column B is animal type; column C is weight.
我需要通过通配符过滤来查找B列中的所有马,然后将日期,动物类型和重量移到电子表格2。
I need to filter by a wildcard to find all the 'horses' in column B and then move the date, the animal type and the weight to spreadsheet 2.
我设法使用
=IF(COUNTIF(Sheet1!B2,"*horse*"),Sheet1!B2,"")
但是我坚持删除所有空白行的第二部分。
but I'm stuck on the 2nd part of removing all the blank rows.
推荐答案
使用以下功能获取你的结果。您可以解析此函数的任何内容以在Sheet2中获得结果。
Use the below function to get your result. You can parse any content to this function to get the result in Sheet2.
Private Function filtercontent(content As String) As String
Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Lastrow
If InStr(Cells(i, 2), content) > 0 Then
Worksheets("Sheet1").Range("A" & i, "C" & i).Copy
With Worksheets("Sheet2")
.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
End With
End If
Next i
End Function
或
Private Function filtercontent(content As String) As String
Dim Lastrow As Long
Dim i As Integer
Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Lastrow
If InStr(Cells(i, 2), content) > 0 Then
Worksheets("Sheet1").Range("A" & i, "C" & i).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1)
End If
Next i
End Function
例如,如果你想为马应用过滤器那么
for example if you want the apply the filter for Horse then
Sub testing()
filtercontent ("Horse")
End Sub
这篇关于过滤值并将数据复制到新工作表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!