| ■No86469 (mako さん) に返信
提示されたコードに手を加えたものです。サンプルデータ作成時のStr関数によるものはスペースがふくまれてしまうので
記述を変更させていただきました。
時間毎にグループ化し最初のデータはかならず出力しそれ以外はインターバルに合った時間のもののみ対象とするようにしてあります。
Public Class Form1
Private Structure datF
Dim Jikoku As String '時刻 （実際は "2018/01/30 16:30:00" などの日付も入った文字列）
Dim Suu1 As Integer '数量1
Dim Suu2 As Integer '数量2
End Structure
Dim Uridat(500) As datF
Dim datS As Integer '
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' 1分間隔のサンプルデータをを成
datS = -1
For i = 10 To 45 ' 8:10〜8:45
datS = datS + 1
'Uridat(datS).Jikoku = "8:" & Str(i) '時刻
Uridat(datS).Jikoku = $"8:{i:00}" '時刻
Uridat(datS).Suu1 = i * 10 '数量1
Uridat(datS).Suu2 = i * 5 '数量2
Next
For i = 20 To 55 ' 10:20〜10:55
datS = datS + 1
'Uridat(datS).Jikoku = "10:" & Str(i) '時刻
Uridat(datS).Jikoku = $"10:{i:00}" '時刻
Uridat(datS).Suu1 = i + 100 '数量1
Uridat(datS).Suu2 = i + 20 '数量2
Next
'==== Chart1 ====
Dim ds As New DataSet
Dim dt As New DataTable
Dim dtRow As DataRow
'列の作成
With dt.Columns
.Add("時刻", GetType(String))
.Add("数量1", GetType(Integer))
.Add("数量2", GetType(Integer))
End With
ds.Tables.Add(dt)
'データのセット
For i = 0 To datS
dtRow = ds.Tables(0).NewRow
dtRow(0) = Uridat(i).Jikoku '時刻
dtRow(1) = Uridat(i).Suu1 '数量1
dtRow(2) = Uridat(i).Suu2 '数量2
ds.Tables(0).Rows.Add(dtRow)
Next
'Chart に表示するデータソースを設定
Dim min As DateTime = Nothing
Dim max As DateTime = Nothing
Dim intr = 30
Dim tbl = GetChartDs(ds, intr, min, max)
Chart1.DataSource = tbl.Select("", "時刻")
Chart1.Series.Clear()
'
With Chart1.ChartAreas(0)
With .AxisX
.Minimum = min.ToOADate
.Maximum = max.ToOADate
.IntervalType = DataVisualization.Charting.DateTimeIntervalType.Minutes
.Interval = intr
Dim isFirst = True
For Each row In tbl.Select("", "時刻")
Dim d = row.Field(Of Date)("時刻")
Dim null = row.IsNull("数量1")
If Not null Then
With .CustomLabels.Add(d.AddMinutes(-intr \ 3).ToOADate, d.AddMinutes(intr \ 3).ToOADate, d.ToString("HH:mm"))
.RowIndex = 0
End With
End If
isFirst = False
Next
End With
End With
Dim ore = Chart1.Series.Add("折れ線")
With ore
.ChartType = DataVisualization.Charting.SeriesChartType.Line
.EmptyPointStyle.SetDefault(True)
.XValueMember = "時刻"
.YValueMembers = "数量1"
End With
Dim bou = Chart1.Series.Add("棒グラフ")
With bou
.ChartType = DataVisualization.Charting.SeriesChartType.Column
.XValueMember = "時刻"
.YValueMembers = "数量2"
End With
End Sub
Private Function GetChartDs(Src As DataSet, IntrMin As Integer,
ByRef Min As DateTime, ByRef Max As DateTime) As DataTable
Dim ret As New DataTable()
Min = Nothing
Max = Nothing
With ret.Columns()
.Add("時刻", GetType(DateTime))
.Add("数量1", GetType(Integer))
.Add("数量2", GetType(Integer))
End With
For Each itm In (From r In Src.Tables(0).Select()
Let d = Function(s As String) As Date
Dim d2 As Date = Nothing
If Date.TryParseExact(s, {"HH:mm", "H:m"}, Nothing, Nothing, d2) Then
Return d2
Else
Return CDate(Nothing)
End If
End Function(r.Field(Of String)("時刻"))
Let h = d.Hour
Group By h Into rows = Group)
Dim hour = itm.h
Dim min2 As Date = Nothing
For Each rowItm In itm.rows
Dim row = rowItm.r
Dim d = rowItm.d
Dim disp = False
If Min = Nothing OrElse d < Min Then Min = d : disp = True
If Max = Nothing OrElse d > Max Then Max = d
If min2 = Nothing OrElse d < min2 Then min2 = d : disp = True
If Not disp Then
If d.Minute Mod IntrMin = 0 Then
disp = True
End If
End If
If disp Then
ret.Rows.Add(d, row("数量1"), row("数量2"))
End If
Next
Next
If Min <> Nothing Then
Min = Min.AddMinutes(-(Min.Minute Mod IntrMin) - IntrMin * 2)
End If
If Max <> Nothing Then
Max = Max.AddMinutes(-(Max.Minute Mod IntrMin) + IntrMin * 2)
End If
Dim d1 As Date = Min
For Each row In ret.Select("", "時刻")
Dim d2 = row.Field(Of Date)("時刻")
Do While d1 < d2
ret.Rows.Add(d1, DBNull.Value, DBNull.Value)
d1 = d1.AddMinutes(IntrMin)
Loop
d1 = d2.AddMinutes(IntrMin)
Next
ret.AcceptChanges()
Return ret
End Function
End Class
|