Question

对不起，如果这有点长。

我被要求列出所有公司员工的名单，创建一个与员工及其经理相关的层次结构，然后创建一个带有主管ID的界面，并输出一个新工作簿，其中包含每个员工的单独表格（最多3个级别），其中包含有关员工替换模板摘要中占位符的信息。

我目前正在成功创建和填充有节点的有向图，这些节点将员工ID作为键，Person对象作为数据。我遇到的问题是当我尝试扩展遍历图方法以便在新工作簿中单独的员工摘要表时。

我编写了下面的代码来创建工作表，如果在给定的主管下面只有约500名员工，则可以完成任务 - 但是，某些主管可以在其中拥有最多2,000名员工级别的深度。对于这些主管，程序将在完全冻结或崩溃之前运行大约10分钟，并且因为我正在打印到直接屏幕，我可以看到它似乎以每个员工/以更慢和更慢的速度创建每个工作表。

我知道这是复制/添加正在执行此操作的工作表，因为只需在遍历中执行de-queue-d节点的Person数据的Debug.Print而不是添加工作表将运行任何主管总共约5秒，无论他们是否有200或2,000名员工。

我想知道是否有办法复制/添加不会产生问题的表格，但更重要的是，我被要求将所有员工置于主管之下相同的工作簿，如果有2000张 - 似乎根本不可能使用该程序的人然后滚动1000多张纸来找到他们每次需要查看的员工。所以，我也试图弄清楚如何为某个级别的每个父节点添加一个工作簿，然后让他们所有的孩子都进入该特定的工作簿 - 我无法弄清楚如何跟踪它将会是哪个工作簿进入，因为层次之间只有员工分离。

以下是图遍历的代码：

Sub TraverseCreateSheets(rootS As String)

Dim wb As Workbook, newWb As Workbook
Set wb = ThisWorkbook
'the below sheet is the template sheet that I am copying to fill out
Dim managementSumTemplate As Worksheet
Set managementSumTemplate = wb.Sheets("Management Summary")


Dim maxDepth As Integer, curDepth As Integer
maxDepth = 3
curDepth = 0


Dim root As node
Set root = pNodeList.Item(rootS)
Dim visited As Object
Set visited = CreateObject("Scripting.Dictionary")

Dim queue As Object
Set queue = CreateObject("System.Collections.Queue")
queue.Enqueue root

Dim nullNode As node
Set nullNode = New node
nullNode.Key = "NULLNODE"
queue.Enqueue nullNode

Workbooks.Add
Set newWb = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayStatusBar = False

'implementation of breadth first search using a queue
'because I had to be able to limit the levels correctly
Dim currentNode As node
Do While queue.Count <> 0
    Set currentNode = queue.Dequeue()

    If Not visited.Exists(currentNode.Key) Then


        If currentNode.Key = "NULLNODE" Then
            curDepth = curDepth + 1
            If curDepth > maxDepth Then
                Exit Do
            End If

            queue.Enqueue nullNode
            Dim peekNode As node
            Set peekNode = queue.Peek
            If peekNode.Key = "NULLNODE" Then
                Exit Do
            End If
        End If

        If Not currentNode.Key = "NULLNODE" Then
            visited.Add currentNode.Key, currentNode


            Dim curPer As Person
            Set curPer = currentNode.Data
            'just doing the below debug statement without any sheet additions can make entire traversal only take 5 seconds 
            Debug.Print "ID: " & currentNode.Key & " Name: " & curPer.Name & _
                " Location: " & curPer.Location & " PyrHead: " & curPer.PyrHead & _
                " Job: " & curPer.Job & " Job Entry: " & curPer.JobEntry & " Time in Pos: " & curPer.TimeInPos & _
                " Hire Date: " & curPer.HireDate & " Supervisor ID " & curPer.SupervisorID & " Supervisor " & curPer.Supervisor


            'adding the worksheet here, since I am copying the 
            'sheet I have to rename
            Dim reportSheet As Worksheet
            managementSumTemplate.Copy Before:=newWb.Sheets(1)
            Set reportSheet = newWb.Worksheets("Management Summary")
            reportSheet.Name = currentNode.Key

            reportSheet.Range("A7").Value = curPer.Location
            reportSheet.Range("A8").Value = curPer.PyrHead
            reportSheet.Range("B7").Value = curPer.Name
            reportSheet.Range("B8").Value = curPer.Job
            reportSheet.Range("B10").Value = curPer.HireDate
            reportSheet.Range("B11").Value = curPer.JobEntry
            reportSheet.Range("B12").Value = curPer.TimeInPos



            For Each neighbor In currentNode.Neighbors
                queue.Enqueue neighbor
            Next neighbor
        End If
    End If

Loop
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

End Sub

在图遍历

0 个答案: