12. februar 2007 - 13:50
Der er
2 kommentarer og
1 løsning
Definere dataområde for graf via datointerval
Hej Eksperter.
Jeg har i kolonnerne A:BJ data for fortløbende datoer.
Er det muligt at lave en indtastningsmulighed, således at en dataområdet for graf baseret på disse data kun medtager et defineret datointerval?
Jeg kan ikke helt greje om dette skal løses via en makro eller ved at lave en graf baseret på en pivot (eller måske en kombination)?
På forhånd tusind tak.
Mvh.
Mortcob
13. februar 2007 - 09:10
#3
Kode i Userform:
Dim dato1, dato2, sidsteKolonne, fra, til
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
Private Sub UserForm_activate()
find_MuligeDatointerval
End Sub
Private Sub find_MuligeDatointerval()
ActiveWorkbook.Sheets("Data").Activate
dato1 = Cells(1, 2)
sidsteKolonne = ActiveCell.SpecialCells(xlLastCell).Column
dato2 = Cells(1, sidsteKolonne)
Label3 = CStr(dato1) + " - " + CStr(dato2)
End Sub
Private Sub commandbutton1_click()
fra = find_Ønskededatointerval(Me.fraDato)
til = find_Ønskededatointerval(Me.tilDato)
If fra <> "" And til <> "" Then
bygDiagram
Else
MsgBox ("En anført dato kan ikke findes i intervallet")
End If
End Sub
Private Function find_Ønskededatointerval(dato)
Dim søgDato As Date
With ActiveWorkbook.Sheets("Data")
søgDato = dato
For k = 2 To sidsteKolonne
If .Cells(1, k) = søgDato Then
find_Ønskededatointerval = isoler_kolonne(.Cells(1, k).Address)
Exit Function
End If
Next k
End With
find_Ønskededatointerval = ""
End Function
Private Function isoler_kolonne(adr)
kolonne = Mid(adr, 2)
p = InStr(kolonne, "$")
isoler_kolonne = Left(kolonne, p - 1)
End Function
Private Sub bygDiagram()
Dim rr As String
Rem Range("A1:A4,E1:G4").Select
rr = "A1:A4" & "," & fra & "1:" & til & "4"
With ActiveWorkbook.Sheets("Data")
.Range(rr).Select
Charts.Add
ActiveChart.ChartType = xlAreaStacked
ActiveChart.SetSourceData Source:=Sheets("Data").Range(rr), PlotBy:= _
xlRows
ActiveChart.Location Where:=xlLocationAsNewSheet
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Statistik over opgaver løst samme dag"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
End With
End Sub
