如何优化在大量logging上运行的macros？

我已经想出了一个用于对付员工的超级pipe理器的macros。 我无法对大型数据集和Excel挂起执行此macros。 我假设这个代码没有被优化。

一些要求和先决条件：

1. 经理ID列将是第一列，即列A，而雇员ID列是第二列，即工作表中的列B.
2. 超级pipe理人员不会填写在表1中，即超出pipe理人员的logging不应该存在于表格1中，除了他们的ID映射到其他员工的经理ID
3. 超级pipe理者将填写在表2中，其顺序与附表中相同。 超级经理Id | 超级经理姓名| 无论需要额外的数据字段。
4. 一旦先决条件被照顾，请点击“macros”button并运行名为Main_Function_SuperManager的macros。
5. 超级经理的细节将分别列在表1的S和T列。

这是我的macros：

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 

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

我的数据结构如下所示：

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

真的期待提示优化这个代码，以便我可以在大型数据集上执行该function。

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

Answer 1

在这个代码中的主要拖动是在工作表中不断的读和写。 如果你使用variables中的数据，代码将会非常快。 事实上，像这样的代码在这样的工作中应该在几秒钟内完成（或更less）。

我已经起草了一个代码中的一个子代码的例子，它可能无法“开箱即用”，因为我完全不了解您的数据结构，但最重要的一点是：从工作簿中获取所有数据只是一次，把它放回那里一次（这是在3 *行）。 逻辑操作应该在内存中完成（数据存储在variables中）。

 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