Дублирующие копии задач при экспорте данных проекта в Excel

Я пытаюсь скопировать данные моего проекта в 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

1 ответ

У вас могут быть проблемы из-за загрузки разных массивов для всех ваших переменных. Если какой-либо из них по какой-либо причине не загружает значение, индексы могут быть сброшены. Вы пытались создать один многомерный массив для хранения значений каждой задачи, а затем вставить весь массив в Excel сразу?

Другие вопросы по тегам