Question

您好我有一份包含不同行动类型的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

Answer 1

这应该这样做：

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

顺便说一下，在宏中尝试不从代码中选择任何内容。这是一种最佳实践，也是优化代码的众多方法之一。

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

1 个答案: