Question

我试图将我的项目数据复制到excel中。代码复制到excel中，但某些任务被复制并复制两次。复制任务的日期也未正确复制。知道为什么有些任务会复制/有不准确的日期吗？

我只想复制任务级别摘要，即大纲级别3或4.我希望复制预测的3组日期，基线和实际日期。

Sub StartExcel()

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim proj As Project
Dim t As Task
Dim pj As Project

Dim TskID() As Integer
Dim TskNam() As String
Dim WBS() As String
Dim UID() As Integer
Dim FStart() As String
Dim FFinish() As String
Dim BStart() As String
Dim BFinish() As String
Dim AStart() As String
Dim AFinish() As String
Dim Entity() As String

Dim NumTsk As Integer, i As Integer, j As Integer, RowIndex As Integer
Dim BookNam As String
Dim c As Range


'Open Excel workbook called "Test"

Set pj = ActiveProject
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open("Test.xlsm")
Set xlSheet = xlBook.Worksheets(3)

'Organize project data into an array
SelectTaskColumn
NumTsk = ActiveSelection.tasks.Count
ReDim TskID(NumTsk), UID(NumTsk), TskNam(NumTsk), WBS(NumTsk), Duration(NumTsk)
ReDim FStart(NumTsk), FFinish(NumTsk), BStart(NumTsk), BFinish(NumTsk), 
AStart(NumTsk), AFinish(NumTsk)

    Application.Caption = "Progress"
    ActiveWindow.Caption = "Gathering Project data into arrays"

    'select array data
    i = 1
    For Each t In ActiveSelection.tasks
     If t.Text2 = "task" And Not t Is Nothing Then
            UID(i) = t.UniqueID
            TskNam(i) = t.Name
            WBS(i) = t.WBS
            FStart(i) = t.ScheduledStart
            FStart(i) = t.ScheduledFinish
            BFinish(i) = t.BaselineStart
            BFinish(i) = t.BaselineFinish
            AStart(i) = t.ActualStart
            AFinish(i) = t.ActualFinish
            i = i + 1
        End If
    Next t

    'Copy array data into excel worksheet

    ActiveWindow.Caption = "Writing data to worksheet"
    Set c = xlSheet.Range("A1")
    RowIndex = 0
    For j = 1 To i - 1
        c.Offset(RowIndex, 0).value = UID(j)
        c.Offset(RowIndex, 1).value = TskNam(j)
        c.Offset(RowIndex, 2).value = WBS(j)
        c.Offset(RowIndex, 3).value = FStart(j)
        c.Offset(RowIndex, 4).value = FFinish(j)
        c.Offset(RowIndex, 5).value = BStart(j)
        c.Offset(RowIndex, 6).value = BFinish(j)
        c.Offset(RowIndex, 7).value = AStart(j)
        c.Offset(RowIndex, 8).value = AFinish(j)
        RowIndex = RowIndex + 1
    Next j

    For Each t In pj.tasks
     If t.Text2 = "task" And Not t Is Nothing Then
        xlSheet.Cells(t.ID + 4, 1).value = t.UniqueID
        xlSheet.Cells(t.ID + 4, 2).value = t.Name
        xlSheet.Cells(t.ID + 4, 3).value = t.WBS
        xlSheet.Cells(t.ID + 4, 4).value = t.ScheduledStart
        xlSheet.Cells(t.ID + 4, 5).value = t.ScheduledFinish
        xlSheet.Cells(t.ID + 4, 6).value = t.BaselineStart
        xlSheet.Cells(t.ID + 4, 7).value = t.BaselineFinish
        xlSheet.Cells(t.ID + 4, 8).value = t.ActualStart
        xlSheet.Cells(t.ID + 4, 9).value = t.ActualFinish

    End If
    Next t

    'Format excel sheet
    xlSheet.Columns("A").AutoFit
    xlSheet.Columns("C:J").ColumnWidth = 13
    xlSheet.Columns("D:J").NumberFormat = "m/d/yy"
    xlSheet.Columns("B").ColumnWidth = 30
    xlSheet.Columns("A:F").VerticalAlignment = xlTop 'reference
    xlSheet.Range("C:D").HorizontalAlignment = xlLeft 'reference


    xlApp.Visible = True

    'Tidy up
        xlApp.UserControl = True
        Set xlApp = Nothing


End Sub

Answer 1

由于为所有变量加载不同的数组，可能会遇到问题。如果其中任何一个因任何原因未加载值，则索引可能会被抛弃。您是否尝试过制作单个多维数组来存储每个任务值，然后将整个数组一次性粘贴到Excel中？

将项目数据导出到Excel时，重复的任务副本

1 个答案: