Question

我已经提出了一个用于为员工填充Super Manager的宏。我无法对大型数据集和Excel挂起执行此宏。我认为这段代码并没有得到很好的优化。

一些要求和先决条件：

经理ID列将是第一列，即列A，而员工ID列是第二列，即工作表中的列B.
超级经理不会填写在表1中，即表1中不存在超级经理的记录，除非他们的ID与其他员工的经理ID相映射
超级管理人员将填写在表2中，其顺序与附表中的顺序相同，即。超级经理ID |超级经理姓名|无论需要多少额外的数据字段。
一旦满足了先决条件，请点击＆＃34;宏＆＃34;按钮并运行名为：Main_Function_SuperManager。
超级管理员详细信息将分别列在工作表1的第S列和第T列中。

这是我的宏：

Option Explicit
Sub Main_Function_SuperManager()
Dim i, re
Root_Parent
Replace
Replace_Name
i = 1
    While Cells(i, 22) <> ""

         Cells(i, 22) = ""
         Cells(i, 23) = ""
         i = i + 1

    Wend
End Sub
Sub Root_Parent()
    Dim i, re, k
    i = 2
    While Cells(i, 1) <> ""
        Set re = Range("B:B").Find(Cells(i, 1))
        If re Is Nothing Then
            Set re = Range("V:V").Find(Cells(i, 1))
            If re Is Nothing Then
                k = k + 1
                Cells(k, 22) = Cells(i, 1)
                Cells(k, 23) = "Super Manager"
                findchild Cells(k, 22).Value, k
            End If
        End If
        i = i + 1
    Wend
End Sub
Sub findchild(parent, ByRef k)
 Dim i, s, re
 i = 1
    While Cells(i, 2) <> ""
    s = i
        Do
            Set re = Range("B:B").Find(Cells(s, 1))
            If re Is Nothing Then
                If Cells(s, 1) = parent Then
                k = k + 1
                Cells(k, 22) = Cells(i, 2)
                Cells(k, 23) = Cells(s, 1)
                End If
                Exit Do
            Else
                s = re.Row
            End If
        Loop
        i = i + 1
    Wend
End Sub

Sub Replace()
    Dim i, re, s
    i = 2
    While Cells(i, 22) <> ""
        Set re = Range("B:B").Find(Cells(i, 22))
        If re Is Nothing Then
        Cells(10, 24) = ""
        Else
         s = re.Row
         Cells(s, 19) = Cells(i, 23)
        End If
        i = i + 1

    Wend
End Sub

Sub Replace_Name()
    Dim i, re, s
    i = 2
    While Cells(i, 19) <> ""
        Set re = Worksheets("Sheet2").Range("A:A").Find(Cells(i, 19))
        If re Is Nothing Then
        Cells(10, 24) = ""
        Else
         s = re.Row
         Cells(i, 20) = Worksheets("Sheet2").Cells(s, 2)
        End If
        i = i + 1

    Wend
End Sub

此代码可帮助我解析大量数据，并将最高级别的根节点列入子节点和子节点。

我的数据结构如下：

MANAGER ID|EMP ID|NAME|GRADE|MANAGER|<some other fields>|SUPER MANAGER ID|SUPER MANAGER NAME

非常期待优化此代码的技巧，以便我可以在大型数据集上执行此功能。

本质上，我希望用各自最高级别的根节点填充子节点，以便所有子节点都有映射到它们的根级数据/父节点。

Answer 1

此代码中的主要拖动是在工作表中不断读取和写出/。如果使用变量中的数据，代码将非常快。事实上，像你这样的代码应该在这种方式下以秒（或更短）完成。

我已经起草了一个受到代码中某个子节点启发的示例，它可能无法“开箱即用”，因为我不完全理解您的数据结构，但最重要的一点是：获取所有数据从工作簿中只需一次，然后将其放回原处（在3 *行中完成）。逻辑操作应该在内存中完成（数据存储在变量中）。

Sub Replace()
    Dim i, re, s, row_num, col_num, data_initial(), data_final()
    Dim WS_1 As Worksheet

    'defines the worksheet object
    Set WS_1 = ThisWorkbook.Worksheets("Sheet1")

    'get where do the data range begins and ends
    row_num = WS_1.Cells(1, 1).End(xlDown).Row
    col_num = WS_1.Cells(1, 1).End(xlToRight).Row

    '***dump the data from the worksheet to memory all in once
    data_initial = WS_1.Cells(1, 1).Resize(Row - 1, col).Value

    'create a blank matrix where the output will be placed
    ReDim data_final(LBound(data_initial, 1) To UBound(data_initial, 1), LBound(data_initial, 2) To UBound(data_initial, 2))

    'you do your work whith the data, this part may not be coherent since I dont understand your data very well
    i = 1
    While i <= UBound(data_initial, 1)
        If data_initial(i, 22) = "" Then
            data_final(i, 24) = ""
        Else
            s = 1
            Do Until data_initial(i, 2) = data_initial(i, 22)
                s = s + 1
            Loop

            data_final(i, 24) = data_initial(i, 23)

            i = i + 1
    Wend

    '***dump the data into the worksheet (again, just once)
    WS_1.Cells(1, 1).Resize(LBound(data_initial, 1) To UBound(data_initial, 1), LBound(data_initial, 2) To UBound(data_initial, 2)).Value = data_final

End Sub

如何优化在大量记录上运行的宏？

1 个答案: