VBA查看列表

我有下面的代码从一列中获取分红字，然后将整行和复制粘贴到一个新的工作表。

Sub SortActions() Dim i&, k&, s$, v, r As Range, ws As Worksheet Set r = [index(a:a,match("###start",a:a,),):index(a:a,match("###end",a:a,),)].Offset(, 6) k = r.Row - 1 v = r For i = 1 To UBound(v) If LCase$(v(i, 1)) = "dividend" Then s = s & ", " & i + k & ":" & i + k End If Next s = Mid$(s, 3) If Len(s) Then Set ws = ActiveSheet With Sheets.Add(, ws) ws.Range(s).Copy .[a1] Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Sheets("20140701_corporate_action_servi").Select Rows("2:2").Select Selection.Copy2 Range("C32").Select Sheets("Sheet11").Select ActiveSheet.Paste End With End If End Sub 

有没有办法使这个dynamic。 所以如果我想search更多的话。 例如，如果我有几行股息和特别股息 – >它将采取所有的股息行和所有行的特别股息，并把它们放在单独的工作表。 我曾试图logging一个macros，它不工作，因为这些词可以不同。 也许将内容join列表将会起作用。 请协助 。 谢谢

Answer 1

正如@Macro Man所build议的那样，我使用一个简单的macros来过滤一个字段，然后过滤一个示例表单和表单的图像。 请归功于@Macro Man，这是一个简单的例子。

简单的代码如下。

 Sub Filter1Field() With Sheet1 .AutoFilterMode = False With .Range("A1:H13") .AutoFilter .AutoFilter Field:=5, Criteria1:="Dividend" End With End With End Sub 

***** UPDATE *******

如果您的其他条件（例如“Sp。Dividend”）是其他栏位，但与附加图片中显示的行相同，且您希望复制到其他栏位，则可以使用下面给出的代码。 另一幅图像显示了sheet2上的结果。 你可以采用代码来满足你的需求。

你可以使用这个代码：

 Sub Test2() Dim LastRow As Long Sheets("Sheet2").UsedRange.Offset(0).ClearContents With Worksheets("Sheet1") .Range("A1:H13").AutoFilter .Range("A1:H13").AutoFilter field:=5, Criteria1:="Dividend" .Range("A1:H13").AutoFilter field:=6, Criteria1:="=Sp. Dividend" LastRow = .Range("A" & .Rows.Count).End(xlUp).Row .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _ Destination:=Sheets("Sheet2").Range("A1") End With End Sub