Option Explicit
Sub TestDemo()
Dim VArrLst As Object
Dim oShp As Shape
Dim oChart As Chart
Dim oAxis As Axis
Dim c As Range, rngDate As Range, rngValue As Range, rngSetChart As Range
Dim dstart As Date
Dim x As Long, y As Long, z As Long
Sheets("Test").Activate
Application.ScreenUpdating = False
With ActiveSheet
'alles löschen
.Columns.Hidden = False
.Rows.Hidden = False
.Cells.Clear
For Each oShp In .Shapes
oShp.Delete
Next oShp
'Demo Werte
Set rngDate = .Range("B6:P6")
Set rngValue = rngDate.Offset(8)
dstart = Date - WorksheetFunction.RandBetween(14, 28)
For Each c In rngDate
c.Value = dstart
c.Offset(8).Value = WorksheetFunction.RandBetween(1, 8) / 10
dstart = dstart + 1
Next c
'Tabelle anpassen
Set VArrLst = CreateObject("System.Collections.ArrayList")
z = rngDate.Columns(rngDate.Columns.Count).Column
x = rngDate.Columns(1).Column
For y = x To z
Set c = .Cells(rngDate.Row, y)
If Weekday(c.Value, 2) > 5 Then
With .Columns(y)
.Interior.Color = 15132390
.Hidden = True
End With
Else
VArrLst.Add Format(c.Value, "dd.mm.yyyy")
End If
Next y
Set rngSetChart = Union(rngDate, rngValue).SpecialCells(xlCellTypeVisible)
'Diagramm
Set oShp = .Shapes.AddChart2(201, xlColumnClustered)
Set oChart = .Shapes(1).Chart
'Datenreihe
oChart.SetSourceData Source:=rngSetChart
'Anzeige korrigieren
Set oAxis = oChart.Axes(1)
oAxis.CategoryNames = VArrLst.toarray
.Columns.Hidden = False
End With
Application.ScreenUpdating = True
End Sub
|