Vba 将动作类型拆分为不同的工作表

Vba 将动作类型拆分为不同的工作表,vba,excel,Vba,Excel,嗨,我有一张excel表格,上面有不同的行动类型,如股息、年度股东大会等 有没有一种方法可以编写一个vba宏,它接受所有动作类型并将它们放在工作簿中的单独工作表中?此外,所有工作表中都应包含日期和时间等标题。由于我是VBA新手,我正在努力使用这个atm:我有一张excel工作表的屏幕截图 再次表示感谢 我有为股息排序的代码,但是我很难将操作放入列表中,然后遍历列表并创建新的工作表 Sub SortActions() Dim i&, k&, s$, v, r As Range,

嗨,我有一张excel表格,上面有不同的行动类型,如股息、年度股东大会等

有没有一种方法可以编写一个vba宏,它接受所有动作类型并将它们放在工作簿中的单独工作表中?此外,所有工作表中都应包含日期和时间等标题。由于我是VBA新手,我正在努力使用这个atm:我有一张excel工作表的屏幕截图

再次表示感谢

我有为股息排序的代码,但是我很难将操作放入列表中,然后遍历列表并创建新的工作表

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
这应该做到:

Public Sub CopyActionTypes()
    Dim i&, k&, key, v, r As Range, ws As Worksheet, d As Object
    On Error Resume Next
    Set r = [index(a:a,match("###start",a:a,),):index(a:a,match("###end",a:a,),)].Offset(, 6)
    If Err = 0 Then
        On Error GoTo 0
        k = r.Row + 1
        v = r
        Set d = CreateObject("scripting.dictionary")
        d.CompareMode = 1
        For i = 1 To UBound(v)
            key = v(i, 1)
            If Len(key) Then
                If Not d.Exists(key) Then d.Add key, k & ":" & k
                d(key) = d(key) & Replace(",.:.", ".", i)
            End If
        Next
        Set ws = ActiveSheet
        For Each key In d.Keys
            If LCase$(key) <> "action_type" Then
                With Sheets.Add(, ws.Parent.Sheets(ws.Parent.Sheets.Count))
                    .Name = key
                    GetRangeUnion(d(key), ws).Copy .[a1]
                End With
            End If
        Next
    End If
End Sub

Private Function GetRangeUnion(s As String, ws As Worksheet) As Range
    Dim i&, v, r As Range
    v = Split(s, ",")
    Set r = ws.Range(v(0))
    For i = 1 To UBound(v)
        Set r = Union(r, ws.Range(v(i)))
    Next
    Set GetRangeUnion = r
End Function

另一方面,在宏运行期间,尽量不要从代码中选择任何内容。这是一种最佳实践,也是优化代码的多种方法之一。

是的,这是绝对可能的。您应该从记录宏开始,看看它生成了什么代码,然后尝试从那里开始。我们不是来为你工作的。