Heippa jälleen!
Täältä olen aiemminkin saanut hyvää neuvoa, joten anelen sitä jälleen. Ongelmani on seuraavanlainen:
Pitäisi saada aikaiseksi kuvaaja, jossa on kuvattuna muutaman (4-10) eri projektin ajanhetkiä. Toisinsanoen pitäsi luoda aikajanoja samaan kuvaajaan useampia. Hommaa on monimutkaistanut se, että aikataulutiedot on pitänyt ensin kaivaa muista exceleistä (verkkokansioissa). Jokaisella projektilla on jokaisesta maalipyykistä perusarvon lisäksi sekä optimistic että worstcase arvo.
Olen yrittänyt tarkaista tätä plottamalla yksinkertaisesti line-chartina päivämäärät (x-akseli) ja projektin numeron. Tällöin syntyy päällekäisiä aikajanoja eri projekteista, mutta excel ei huomioi päivämäärien etäisyyksiä toisistaan. Eli jos listassa oli 1.1.2006 ja 1.6.2006 peräkkäin, ne ovat aivan vierekkäin kuvaajassakin. Yritin korjata tätä vaihtamalla charttyypin XY-scatteriksi. Tässä päivämäärät eivät kuitenkaan edelleenkään oikein toimineet. Sain kuitenkin jonkinlaisen järkevän kuvan aikaiseksi laskemalla x-arvoiksi päivämäärien sijaan päivät ensimmäisestä tapahtumasta. Nyt on sitten x-akselilla pelkkiä numeroita, eikä tämäkään ole oikein täydellinen ratkaisu.
Generoin kyseisen chartin oheisella koodilla (myönnän, että tämä on osin melko purkkaviritys):
Public Sub Aikataulunluonti()
' Tällä subilla luodaan uudelle sivulle chartti, jossa on jokaisen projektin
' aikataulu viivadiagrammina
Dim i As Integer
'Sortataan ensin kaikki data
Rows("3:346").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
'Täytetään päivät apusarake.
i = 4
Application.Sheets(6).Cells(2, 2).Value = "Päivät"
Application.Sheets(6).Cells(3, 2).Value = "0"
Do While Application.Sheets(6).Cells(i, 1) <> 0
'Application.Sheets(6).Cells(i, 2).Value = Sheets(6).Cells(i, 1) - Sheets(6).Cells(i - 1)
Application.Sheets(6).Cells(i, 2).Select
ActiveCell.FormulaR1C1 = "=RC[-1]-R3C[-1]"
i = i + 1
Loop
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "General" 'ilman tätä Excel ei tunnistanut kaikkia numeroiksi
'Valitaan chartin data alue
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
'Lisätään chartti
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets("Master Schedule").Range("B2:K42"), _
PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Schedule"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Schedule"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _
"Päivät ensimmäisestä arvosta"
.Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = False
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
Sheets("Schedule").Select
Sheets("Schedule").Move After:=Sheets(7)
End SubItse tekisin tuon niin, että etsisin valituista sarjoista ensimmäisen ja viimeisen päivän, eli missä sarjassa on aikaisin päivä ja missä viimeinen, jolla on merkintä. Tämän jälkeen tekisin jonnekkin sivuun uuden taulukon ensimmäisestä päivästä viimeiseen päivän ja sijoittaisin sarjat tähän uuteen tauluun, jota sitten käyttäisin kuvaajan luontiin.
Sub AutoFillDate()
Dim LensiUlos As Boolean
Dim ArrA As Variant
Dim ArrB As Variant
Dim i As Integer
Dim j As Integer
'nopeutetaan koodiamme piilottamalla tekemisemme käytäjältä
Application.ScreenUpdating = False
'kaksi lista päivämääristä, jotka lisätään taulukkoon
ArrA = Array("5.1.2006", "7.1.2006", "8.1.2006", "11.1.2006", "14.1.2006", _
"15.1.2006", "18.1.2006", "23.1.2006", "24.1.2006", "31.1.2006")
ArrB = Array("1.1.2006", "5.1.2006", "6.1.2006", "7.1.2006", "19.1.2006", _
"21.1.2006", "23.1.2006", "26.1.2006", "28.1.2006", "29.1.2006")
'listataan päivämäärät väliltä 1.-31.1.2006
Range("B2").FormulaR1C1 = "1/1/2006"
'käytetään seuraavaksi Excelin Fill-mahdollisuutta täyttämään listaa alaspäin
Range("B2").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, _
Step:=1, Stop:="1/31/2006", Trend:=False
'käydään listat läpi lisäten halutun päivämäärän kohdalle merkintä
For j = LBound(ArrA) To UBound(ArrA)
i = 0
Do Until Range("B2").Offset(i, 0).Value = DateValue(ArrA(j))
i = i + 1
LensiUlos = True
If IsEmpty(Range("B2").Offset(i, 0).Value) Then Exit Do
LensiUlos = False
Loop
If Not LensiUlos Then Range("B2").Offset(i, 1).Value = "foo"
Next j
For j = LBound(ArrB) To UBound(ArrB)
i = 0
Do Until Range("B2").Offset(i, 0).Value = DateValue(ArrB(j))
i = i + 1
LensiUlos = True
If IsEmpty(Range("B2").Offset(i, 0).Value) Then Exit Do
LensiUlos = False
Loop
If Not LensiUlos Then Range("B2").Offset(i, 2).Value = "bar"
Next j
'palautetaan ScreenUpdating, että käyttäjä näkee mitä ollaan tehty
Application.ScreenUpdating = True
End SubKuvaajassa kannattaa käyttää pelkkiä pisteitä käyrillä, sillä jos käyrältä puuttuu päiviä välistä, niin viivaa ei vedetä näiden välille.
Kiitos jälleen kerran! Välillä ei vain itse tajua tehdä asioita jollain tavalla. Tuo uuden listan teko oli nerokas ratkaisu. Nyt näyttää kuvaaja juuri siltä mitä hain!
Aihe on jo aika vanha, joten et voi enää vastata siihen.