如何将总表中的不同单位的人员信息索引到对应的工作表中

附件

测算表.zip(34.52 KB)

2011-8-8 21:47, 下载次数: 8

复制内容到剪贴板

代码:

Sub aa()
    Dim arr, d As Object, i%, h%, m%, k, n
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.Range("c3", Sheet1.[c65536].End(3))
    For i = 1 To UBound(arr)
        d(arr(i, 1)) = i
    Next
    k = d.keys
    n = d.items
    For i = 0 To UBound(k)
        If i = 0 Then
            Sheet1.Range("a1", "v2").Copy Sheets(k(i)).Range("a1", "v2")
            Sheets(k(i)).Range("a3", "v" & n(i) + 2).Value = Sheet1.Range("a3", "v" & n(i) + 2).Value
        Else
            h = n(i - 1) + 3
            m = n(i) - n(i - 1) + 2
            Sheet1.Range("a1", "v2").Copy Sheets(k(i)).Range("a1", "v2")
            Sheets(k(i)).Range("a3", "v" & m).Value = Sheet1.Range("a" & h, "v" & n(i) + 2).Value
        End If
    Next
End Sub

附件

拆分总表.rar(37.14 KB)

2011-8-8 23:01, 下载次数: 0