07. april 2010 - 16:23
Der er
6 kommentarer og
1 løsning
fortsættelse: http://www.eksperten.dk/spm/906426
Hjælp til automatisk ændring af diagram, når nye datafelter bliver opdateret.
Jeg har brug for at få opdateret op til flere diagrammer i ét ark, når der tilføjes yderligere oplysninger i arket - til de respektive diagrammer.
jeg har dato som x-akse og pris som y-akse
fx har jeg
A4 "Dato";B4 '01-01-2010';C4 '01-02-2010'; mv...
A5 "Pris";B5 '800'; C5 '850'; mv...
Hvordan får jeg diagrammet til at automatisk opdatere med viden om denne data?
07. april 2010 - 23:33
#5
Rem Version 2
Rem =========
Dim pris As Single, varenr As String, dato As Date
Dim statRække As Long, kol As Byte
Private Sub Worksheet_Change(ByVal Target As Range)
Rem der ændres i arket
If Target.Column = 9 And Target.Value <> "" Then 'kolonne "I" (PRIS)
pris = Target.Value
varenr = Range("D" & Target.Row).Text
dato = Format(Now, "dd-mm-yy")
statRække = findRækkeNr(varenr, "STAT", "C:C")
If statRække > 0 Then
opdaterNyPris pris, dato, statRække + 2 '+2 da prislinje er 2 rækker under ID-linje
justerDiagram statRække + 2, kol, varenr
Else
MsgBox ("varenr " & varenr & " kunne ikke findes i STAT")
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 12 Then 'kolonne L (STAT)
varenr = Range("D" & Target.Row).Text
statRække = findRækkeNr(varenr, "STAT", "C:C")
If statRække > 0 Then
aktiverArk "STAT", statRække 'LINK TIL STAT
Else
MsgBox ("varenr " & varenr & " kunne ikke findes i STAT")
End If
End If
End Sub
Private Function findRækkeNr(varenr, arkNavn, område)
With ActiveWorkbook.Sheets(arkNavn).Range(område)
Set c = .Find(varenr, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
findRækkeNr = c.Row
Else
findRækkeNr = 0
End If
End With
End Function
Private Sub aktiverArk(arkNavn, rækkeNr)
ActiveWorkbook.Sheets(arkNavn).Activate
ActiveSheet.Range("C" & CStr(rækkeNr)).Activate
End Sub
Private Sub opdaterNyPris(pris, dato, rækkeNr)
With ActiveWorkbook.Sheets("STAT")
For kol = 1 To 240
If .Cells(rækkeNr, kol) = "" Then
.Cells(rækkeNr, kol) = dato
.Cells(rækkeNr + 1, kol) = pris
.Columns.AutoFit
Exit For
End If
Next kol
End With
End Sub
Private Sub justerDiagram(statRække, kolonne, varenr)
Dim kildeOmråde As String, sx, dia As ChartObject
Rem find hvilket diagram, det drejer sig om
With ActiveWorkbook.Sheets("STAT")
For ix = 1 To .ChartObjects.Count
.ChartObjects(ix).Activate
If ActiveChart.ChartTitle.Text = Trim(varenr) Then
kildeOmråde = "STAT!$A$" & CStr(statRække) & ":$" & Chr(kolonne + 64) & "$" & CStr(statRække + 1)
ActiveChart.SetSourceData Source:=Sheets("STAT").Range(kildeOmråde)
End If
Next ix
End With
End Sub
