VBA浏览列表

时间:2015-09-08 10:30:12

标签: excel vba excel-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

有没有办法让这种动态。所以,如果我想搜索更多的单词。例如,如果我有几行带有股息和特殊股息 - >它会占用所有股息和所有特殊股息行,并将它们分成不同的表格。我已经尝试过录制一个宏,它不起作用,因为单词可以有所不同。也许将内容放入列表会起作用。请协助 。感谢

1 个答案:

答案 0 :(得分:2)

根据@Macro Man的建议,我在过滤后使用简单的宏提交示例工作表和图纸的图像,以过滤一个字段。请全部归功于@Macro Man,以简单的方式进行说明。

sample file enter image description here

简单代码如下。

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上获得的结果。您可以将代码用于您的要求。

sample 2 sample 2 after filter on sheet 2

您可以使用此代码:

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