Дублирующие копии задач при экспорте данных проекта в 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 сразу?