von Xlsibb » 07. Mär 2017, 15:28
Hallo!
Tut mir leid, ich kann hier nicht immer online sein und in letzter Zeit war zuviel los (=> es gibt ein Leben außerhalb dieses Forums)
Ich habe mir das nochmal angeguckt. Mein Code geht alle Tasks durch und danach alle Subprojekte, aber unabhängig von den Tasks des Hauptprojekts.
Man müsste also die Schleifen ineinander verschachteln. Dadurch ist es sehr wahrscheinlich, dass der Programmablauf sehr, sehr lange dauert. Trotzdem hier ein (UNGETESTETER!!) Versuch:
Das muss dann aber genug der Hilfe sein (ich habe es sogar kommentiert!) Schließlich dient das Forum als Hilfe zur Selbsthilfe!!
- Code: Alles auswählen
Sub doppelte_Eintraege()
Dim sprj, sprj2 As Subproject
Dim tsk, tskSP As Task
Dim strSprj, strSprj2, strTask, strTask2 As String
Dim i As Integer
'Alle Vorgänge des Hauptprojekts durchgehen
For Each tsk In ActiveProject.Tasks
'aktiver Task
strTask = tsk.Name
'jeden Task unterhalb des aktiven Tasks durchgehen und vergleich
For i = tsk.Index + 1 To ActiveProject.Tasks.Count
'gelb markieren, wenn gleich
If ActiveProject.Tasks(i).Name = strTask Then
Application.SelectRow row:=tsk.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(i).ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
'nun in alle Unterprojekte gehen und alle Tasks der Unterprojekte mit dem aktiven Task vergleichen
For Each sprj In ThisProject.Subprojects
'Name des Unterprojekts ohne Dateipfad
strSprj = Left(sprj.SourceProject.Name, Len(sprj.SourceProject.Name) - 4)
'Jeden Task des Unterprojekts durchgehen
For Each tskSP In sprj.SourceProject.Tasks
'gelb markieren, wenn gleich
If tskSP.Name = strTask Then
Application.SelectRow row:=tsk.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + tskSP.ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
Next tsk
Next sprj
Next tsk
'Separat alle Unterprojekte durchgehen und die Tasks innerhalb EINES Unterprojekts vergleichen
For Each sprj In ThisProject.Subprojects
strSprj = Left(sprj.SourceProject.Name, Len(sprj.SourceProject.Name) - 4)
For Each tsk In sprj.SourceProject.Tasks
strTask = tsk.Name
For i = tsk.Index + 1 To sprj.SourceProject.Tasks.Count
If sprj.SourceProject.Tasks(i).Name = strTask Then
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + tsk.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + sprj.SourceProject.Tasks(i).ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
Next tsk
'und zum Schluss noch alle anderen Unterprojekte durchgehen
'und die Tasks der Unterprojekte mit den Tasks aller anderen Unterprojekte vergleichen
For Each sprj2 In ThisProject.Subprojects
'Prozedur nur ausführen, wenn das andere Unterprojekt unter dem aktuell durchsuchten liegt
If sprj2.Index > sprj.Index Then
strSprj2 = Left(sprj2.SourceProject.Name, Len(sprj2.SourceProject.Name) - 4)
For Each tskSP In sprj2.SourceProject.Tasks
strTask2 = tskSP.Name
For i = tskSP.Index + 1 To sprj2.SourceProject.Tasks.Count
'gelb markieren, wenn gleich. Hier musst du wahrscheinlich schauen, wie sich die IDs addieren.
If sprj2.SourceProject.Tasks(i).Name = strTask2 Then
Application.SelectRow row:=ActiveProject.Tasks(strSprj2).ID + tskSP.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + sprj.SourceProject.Tasks(i).ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
Next tsk2
End If
Next sprj2
Next sprj
End Sub
Hallo!
Tut mir leid, ich kann hier nicht immer online sein und in letzter Zeit war zuviel los (=> es gibt ein Leben außerhalb dieses Forums)
Ich habe mir das nochmal angeguckt. Mein Code geht alle Tasks durch und danach alle Subprojekte, aber unabhängig von den Tasks des Hauptprojekts.
Man müsste also die Schleifen ineinander verschachteln. Dadurch ist es sehr wahrscheinlich, dass der Programmablauf sehr, sehr lange dauert. Trotzdem hier ein (UNGETESTETER!!) Versuch:
Das muss dann aber genug der Hilfe sein (ich habe es sogar kommentiert!) Schließlich dient das Forum als Hilfe zur Selbsthilfe!!
[code]
Sub doppelte_Eintraege()
Dim sprj, sprj2 As Subproject
Dim tsk, tskSP As Task
Dim strSprj, strSprj2, strTask, strTask2 As String
Dim i As Integer
'Alle Vorgänge des Hauptprojekts durchgehen
For Each tsk In ActiveProject.Tasks
'aktiver Task
strTask = tsk.Name
'jeden Task unterhalb des aktiven Tasks durchgehen und vergleich
For i = tsk.Index + 1 To ActiveProject.Tasks.Count
'gelb markieren, wenn gleich
If ActiveProject.Tasks(i).Name = strTask Then
Application.SelectRow row:=tsk.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(i).ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
'nun in alle Unterprojekte gehen und alle Tasks der Unterprojekte mit dem aktiven Task vergleichen
For Each sprj In ThisProject.Subprojects
'Name des Unterprojekts ohne Dateipfad
strSprj = Left(sprj.SourceProject.Name, Len(sprj.SourceProject.Name) - 4)
'Jeden Task des Unterprojekts durchgehen
For Each tskSP In sprj.SourceProject.Tasks
'gelb markieren, wenn gleich
If tskSP.Name = strTask Then
Application.SelectRow row:=tsk.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + tskSP.ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
Next tsk
Next sprj
Next tsk
'Separat alle Unterprojekte durchgehen und die Tasks innerhalb EINES Unterprojekts vergleichen
For Each sprj In ThisProject.Subprojects
strSprj = Left(sprj.SourceProject.Name, Len(sprj.SourceProject.Name) - 4)
For Each tsk In sprj.SourceProject.Tasks
strTask = tsk.Name
For i = tsk.Index + 1 To sprj.SourceProject.Tasks.Count
If sprj.SourceProject.Tasks(i).Name = strTask Then
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + tsk.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + sprj.SourceProject.Tasks(i).ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
Next tsk
'und zum Schluss noch alle anderen Unterprojekte durchgehen
'und die Tasks der Unterprojekte mit den Tasks aller anderen Unterprojekte vergleichen
For Each sprj2 In ThisProject.Subprojects
'Prozedur nur ausführen, wenn das andere Unterprojekt unter dem aktuell durchsuchten liegt
If sprj2.Index > sprj.Index Then
strSprj2 = Left(sprj2.SourceProject.Name, Len(sprj2.SourceProject.Name) - 4)
For Each tskSP In sprj2.SourceProject.Tasks
strTask2 = tskSP.Name
For i = tskSP.Index + 1 To sprj2.SourceProject.Tasks.Count
'gelb markieren, wenn gleich. Hier musst du wahrscheinlich schauen, wie sich die IDs addieren.
If sprj2.SourceProject.Tasks(i).Name = strTask2 Then
Application.SelectRow row:=ActiveProject.Tasks(strSprj2).ID + tskSP.ID, rowrelative:=False
Font32Ex CellColor:=65535
Application.SelectRow row:=ActiveProject.Tasks(strSprj).ID + sprj.SourceProject.Tasks(i).ID, rowrelative:=False
Font32Ex CellColor:=65535
End If
Next i
Next tsk2
End If
Next sprj2
Next sprj
End Sub
[/code]