LoginSignup
0
3

More than 5 years have passed since last update.

VBAでシートに並んだデータから選択した列のデータをグラフにする

Last updated at Posted at 2017-02-19

excel2013からか解らないけど、PlotAreaのInsideWidthとかInsideHeightを設定できるようになってるし、InsideTopとInsideLeftも合わせたらグラフのプロットエリアの位置・大きさを揃えられるようになっててありがたい。

Option Explicit

'|  x軸  |      |
'----------------
'|y軸1軸1|y軸2軸2|
'----------------
'|y軸1軸2|y軸2軸2|
'----------------
'……
'って感じで値入れてx軸のとこにカーソル置いて実行

Const labelsRow = 2

Sub setRangeNames()
Dim i As Long
Dim limRow As Long
    'グラフのために名前付き範囲設定
    With Sheets("bunseki")
        limRow = .Cells(labelsRow + 1, 1).End(xlDown).Row '室温とかでデータに抜けがあってもいいように
        For i = 1 To .Cells(labelsRow, 1).End(xlToRight).Column
            ActiveWorkbook.Names.Add name:=.Cells(labelsRow, i).Value, _
                                                            RefersTo:="=OFFSET(bunseki!$" & convertColumnIndexToAlphabet(i) & "$" & labelsRow & _
                                                                                ",1,0,COUNTA(bunseki!$" & convertColumnIndexToAlphabet(i) & _
                                                                                ":$" & convertColumnIndexToAlphabet(i) & ")-1,1)"
        Next i
    End With
End Sub

'列番号から範囲の名前を取得
Function getRangeName(idx As Long) As String
    getRangeName = Sheets("bunseki").Cells(labelsRow, idx).Value
End Function

'範囲の名前から列番号を取得
Function getRangeNameIndex(rangeName As Variant) As Long
On Error GoTo Err_trap 'Matchで範囲名が見つからなかったとき
    With Sheets("bunseki")
        getRangeNameIndex = Application.WorksheetFunction.Match(rangeName, .Range(.Cells(labelsRow, 1), .Cells(labelsRow, 1).End(xlToRight)), 0)
    End With
    Exit Function
Err_trap:
    MsgBox "エラーコード:" & Err.Number & vbCrLf & Err.Description & vbCrLf & vbCrLf & "系列名が間違っている可能性があります"
    End
End Function

'グラフにする列番号を配列に入れる
Function getIdxArray(col As Long) As Variant
Dim idxArray As Variant
Dim i As Long
    If ActiveCell.Offset(1, col) = "" Or ActiveCell.Offset(2, col) = "" Then
        idxArray = Sheets("グラフ").Range(ActiveCell.Offset(1, col), ActiveCell.Offset(2, col))
    Else
        idxArray = Sheets("グラフ").Range(ActiveCell.Offset(1, col), ActiveCell.Offset(1, col).End(xlDown))
    End If

    '列番号じゃなく名前が入力されてたら列番号に変換
    For i = 1 To UBound(idxArray)
        If idxArray(i, 1) = "" Or VarType(idxArray(i, 1)) <> vbString Then
            Exit For
        End If
        idxArray(i, 1) = getRangeNameIndex(idxArray(i, 1))
    Next i
    getIdxArray = idxArray
End Function

Sub addGraph()
Dim x As Long
Dim yls As Variant, yrs As Variant
Dim i As Long
Const graphWidth = 1080
Const graphHeight = 300
    Call setRangeNames '名前付き範囲設定(更新)
    If VarType(ActiveCell.Value) = vbString Then
        x = getRangeNameIndex(ActiveCell.Value)
    Else
        x = ActiveCell.Value
    End If
    yls = getIdxArray(0) 'Sheets("グラフ").Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0).End(xlDown))
    yrs = getIdxArray(1) 'Sheets("グラフ").Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(1, 1).End(xlDown))
    '空のグラフ作成
    'Charts.Add.Location where:=xlLocationAsObject, name:=ActiveSheet.name
    With ActiveSheet.ChartObjects.Add(ActiveCell.Left, ActiveCell.Top, graphWidth, graphHeight).Chart
        .ChartType = xlLine '折れ線グラフ
        '.Parent.name = "a"
        '.PlotArea.Width = graphWidth * 0.8
        '.PlotArea.Height = graphHeight * 0.8
        'データ系列作成
        '第1軸
        For i = 1 To UBound(yls)
            If yls(i, 1) <> "" Then
                With .SeriesCollection.NewSeries
                    '.ChartType = xlLine '折れ線グラフ
                    .XValues = Range(getRangeName(x))
                    .Values = Range(getRangeName(CLng(yls(i, 1))))
                    .name = getRangeName(CLng(yls(i, 1)))
                End With
            End If
        Next i
        '第2軸
        For i = 1 To UBound(yrs)
            If yrs(i, 1) <> "" Then
                With .SeriesCollection.NewSeries
                    '.ChartType = xlLine '折れ線グラフ
                    .XValues = Range(getRangeName(x))
                    .Values = Range(getRangeName(CLng(yrs(i, 1))))
                    .name = getRangeName(CLng(yrs(i, 1)))
                    .AxisGroup = xlSecondary '第2軸に
                End With
            End If
        Next i
    End With

    'プロットエリアの内部サイズ揃える
    With Sheets("グラフ").ChartObjects(Sheets("グラフ").ChartObjects.Count).Chart
        .PlotArea.InsideWidth = graphWidth * 0.85
        .PlotArea.InsideHeight = graphHeight * 0.85
        .PlotArea.InsideTop = 30 '(.ChartArea.Height - .PlotArea.Height) / 2
        .PlotArea.InsideLeft = 30 '(.ChartArea.Width - .PlotArea.Width) / 2
    End With
End Sub

'すべてのプロットエリアの内部サイズ揃える
Sub adjustInsidePlotAreaOfAllGraphs()
Dim i As Long
    For i = 1 To Sheets("グラフ").ChartObjects.Count
        With Sheets("グラフ").ChartObjects(i).Chart
            .PlotArea.InsideWidth = graphWidth * 0.85
            .PlotArea.InsideHeight = graphHeight * 0.85
            .PlotArea.InsideTop = 30 '(.ChartArea.Height - .PlotArea.Height) / 2
            .PlotArea.InsideLeft = 30 '(.ChartArea.Width - .PlotArea.Width) / 2
        End With
    Next i
End Sub

'特定の範囲だけグラフ化する(途中)
Function getTimeRow(timeStr As String) As Long
    getTimeRow = 1
End Function

Sub addGraphSecond()
Dim x As Long
Dim yls As Variant, yrs As Variant
Dim i As Long
Dim startRowTime As String
Dim endRowTime As String
    Call setRangeNames '名前付き範囲設定(更新)
    If VarType(ActiveCell.Value) = vbString Then
        x = getRangeNameIndex(ActiveCell.Value)
    Else
        x = ActiveCell.Value
    End If
    yls = getIdxArray(0) 'Sheets("グラフ").Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0).End(xlDown))
    yrs = getIdxArray(1) 'Sheets("グラフ").Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(1, 1).End(xlDown))
    If ActiveCell.Offset(0, 1) <> "" And ActiveCell.Offset(0, 2) <> "" Then
        startRowTime = 4
        endRowTime = 6
    End If

    '空のグラフ作成
    'Charts.Add.Location where:=xlLocationAsObject, name:=ActiveSheet.name
    With ActiveSheet.ChartObjects.Add(ActiveCell.Left, ActiveCell.Top, graphWidth, graphHeight).Chart
        .ChartType = xlLine '折れ線グラフ
        '.Parent.name = "a"
        '.PlotArea.Width = graphWidth * 0.8
        '.PlotArea.Height = graphHeight * 0.8
        'データ系列作成
        '第1軸
        For i = 1 To UBound(yls)
            If Not IsEmpty(yls(i, 1)) Then
                If ActiveCell.Offset(0, 1) <> "" And ActiveCell.Offset(0, 2) <> "" Then
                    With .SeriesCollection.NewSeries
                        '.ChartType = xlLine '折れ線グラフ
                        .XValues = Sheets("bunseki").Range(Sheets("bunseki").Cells(startRowTime, x), _
                                                                                Sheets("bunseki").Cells(endRowTime, x))
                        .Values = Sheets("bunseki").Range(Sheets("bunseki").Cells(startRowTime, CLng(yls(i, 1))), _
                                                                            Sheets("bunseki").Cells(endRowTime, CLng(yls(i, 1))))
                        .name = getRangeName(CLng(yls(i, 1)))
                    End With
                Else
                    With .SeriesCollection.NewSeries
                        '.ChartType = xlLine '折れ線グラフ
                        .XValues = Range(getRangeName(x))
                        .Values = Range(getRangeName(CLng(yls(i, 1))))
                        .name = getRangeName(CLng(yls(i, 1)))
                    End With
                End If
            End If
        Next i
        '第2軸
        For i = 1 To UBound(yrs)
            If Not IsEmpty(yrs(i, 1)) Then
                If ActiveCell.Offset(0, 1) <> "" And ActiveCell.Offset(0, 2) <> "" Then
                    With .SeriesCollection.NewSeries
                        '.ChartType = xlLine '折れ線グラフ
                        .XValues = Sheets("bunseki").Range(Sheets("bunseki").Cells(startRowTime, x), _
                                                                                Sheets("bunseki").Cells(endRowTime, x))
                        .Values = Sheets("bunseki").Range(Sheets("bunseki").Cells(startRowTime, CLng(yrs(i, 1))), _
                                                                                Sheets("bunseki").Cells(endRowTime, CLng(yrs(i, 1))))
                        .name = getRangeName(CLng(yrs(i, 1)))
                    End With
                Else
                    With .SeriesCollection.NewSeries
                        '.ChartType = xlLine '折れ線グラフ
                        .XValues = Range(getRangeName(x))
                        .Values = Range(getRangeName(CLng(yrs(i, 1))))
                        .name = getRangeName(CLng(yrs(i, 1)))
                        .AxisGroup = xlSecondary '第2軸に
                    End With
                End If
            End If
        Next i
        i = .PlotArea.InsideWidth
        .PlotArea.InsideWidth = graphWidth * 0.85
        .PlotArea.InsideHeight = graphHeight * 0.85
        .PlotArea.InsideTop = 30 '(.ChartArea.Height - .PlotArea.Height) / 2
        .PlotArea.InsideLeft = 30 '(.ChartArea.Width - .PlotArea.Width) / 2

    End With

    'プロットエリアの内部サイズ揃える
    'Sheets("グラフ").ChartObjects(Sheets("グラフ").ChartObjects.Count).Chart.PlotArea.InsideWidth = graphWidth * 0.85
    'Sheets("グラフ").ChartObjects(Sheets("グラフ").ChartObjects.Count).Chart.PlotArea.InsideHeight = graphHeight * 0.85
    'Sheets("グラフ").ChartObjects(Sheets("グラフ").ChartObjects.Count).Chart.PlotArea.Top = 10
    'Sheets("グラフ").ChartObjects(Sheets("グラフ").ChartObjects.Count).Chart.PlotArea.Left = 30
    With Sheets("グラフ").ChartObjects(Sheets("グラフ").ChartObjects.Count).Chart

            '.PlotArea.InsideWidth = graphWidth * 0.85
            '.PlotArea.InsideHeight = graphHeight * 0.85
            '.PlotArea.InsideTop = 30 '(.ChartArea.Height - .PlotArea.Height) / 2
            '.PlotArea.InsideLeft = 30 '(.ChartArea.Width - .PlotArea.Width) / 2
        End With
End Sub

'20180104
Option Explicit

Const BYTE_NUM = 512        '全停止ごとに記憶されるデータのバイト数
Const DATA_COL = 4          '全停止何回分まで記憶されてるか
Const STRING_LINE_NUM = 32  '?
Const DATA_MINUTE = 15      '何分間のデータが記憶されてるか
Const ELEM_NUMS = 24        'グラフに表示する要素の種類
Const FIRST_ROW = 2         '第1軸に表示する要素名が入力されてる最初の行
Const FIRST_COL = 3         '第1軸に表示する要素名が入力されてる列
Const GRAPH_WIDTH = 500    'グラフの幅
Const GRAPH_HEIGHT = 300    'グラフの高さ

Enum GraphElements
    コンプ回転数 = 0
    室温
    内熱交温度
    吐出温度
    外熱交温度
    外気温
    ヒートシンク温度
    ファン回転数
    DC電圧
    電流値
    コンプON時間
    FD
    内ファン
    目標コンプ回転数
    ピーコン
    暖房ピーコン
    二方弁温度
    サクション温度
    目標ファン回転数
    ピーコンレベル
    A膨張弁開度
    B膨張弁開度
    目標SH
    目標SHsub
End Enum



Function ReadText() As Variant
'テキストファイル読み込んでそのまま返す
Dim OpenFileName As String
Dim buf As String
Dim txtLines As Variant
    'OpenFileName = Application.GetOpenFilename("エラーデータ,*.txt?")
    OpenFileName = "Users/fumiharahirotoshi/Desktop/test.txt"
    With CreateObject("Scripting.FileSystemObject")
        With .GetFile(OpenFileName).OpenAsTextStream
            buf = .ReadAll
            .Close
        End With
    End With
    ReadText = buf

End Function

Function FormatText(errorData As String) As Variant
'まるごとのテキストファイルを配列に成形
'文字列のかたまり→1列512byteのString配列→1列512byteの整数配列
Dim tmpArray As Variant
Dim errorStringArray(0 To DATA_COL - 1) As String
Dim errorArray(0 To BYTE_NUM - 1, 0 To DATA_COL - 1) As Long
Dim errorI As Long
Dim errorJ As Long
Dim i As Long
Dim j As Long
    tmpArray = Split(errorData)
    For i = 0 To unbound(tmpArray)
        errorStringArray(i Mod STRING_LINE_NUM, i / STRING_LINE_NUM) = tmpArray(i + 1)
    Next i


    For i = 1 To BYTE_NUM
        For j = 1 To DATA_COL
            errorArray(errorI, errorJ) = tmpArray(i, j)
        Next j
    Next i


End Function

Function HexStr512ToIntArray(hexStr512 As String) As Integer()
'Stringの512byte分1024文字を512個の整数配列に
'Stringから2文字ずつ抜き出す http://www.relief.jp/docs/excel-vba-fill-array-with-each-2-characters.html
'Debug.Print Val("&HA") '→10(整数) https://www.tipsfound.com/vba/05hex
Dim i As Long
Dim cnt As Long
Dim intArray(0 To BYTE_NUM - 1) As Integer

    cnt = (Len(hexStr512) + 1) \ 2
    For i = 0 To cnt - 1
        intArray(i) = Val("&H" & Mid(hexStr512, i * 2 + 1, 2)) '2文字ずつ抜き出したStringに&Hを付けてからValで16進数考慮の整数に
    Next i
    HexStr512ToIntArray = intArray

End Function

Function getIdxArray(axisNum As Long) As Variant
'表示する要素名を配列で取得
'axisNum: グラフ軸 1 or 2
Dim idxArray As Variant
Dim i As Long
    If ActiveSheet.Cells(FIRST_ROW, FIRST_COL + axisNum - 1).Text = "" Then
        'idxArray = Sheets("グラフ").Range(ActiveCell.Offset(1, col), ActiveCell.Offset(2, col))
        End '表示する要素がないから終了
    ElseIf ActiveSheet.Cells(FIRST_ROW + 1, FIRST_COL + axisNum - 1).Text = "" Then
        idxArray = ActiveSheet.Range(ActiveSheet.Cells(FIRST_ROW, FIRST_COL + axisNum - 1), ActiveSheet.Cells(FIRST_ROW + 1, FIRST_COL + axisNum - 1))
        'idxArray = Array(ActiveSheet.Cells(FIRST_ROW, FIRST_COL))
    Else
        idxArray = ActiveSheet.Range(ActiveSheet.Cells(FIRST_ROW, FIRST_COL + axisNum - 1), ActiveSheet.Cells(FIRST_ROW, FIRST_COL + axisNum - 1).End(xlDown))
    End If
    getIdxArray = idxArray

End Function

Sub tetetete()
Dim v As Variant
Dim i As Long
Dim j As Long
v = getIdxArray(1)
Debug.Print v(1, 1)
Debug.Print v(2, 1)
For i = 1 To UBound(v, 1)
    For j = 1 To UBound(v, 2)
        Debug.Print i, j, v(i, j)
    Next j
Next i

Debug.Print ActiveSheet.Cells(2, 3).End(xlDown).Row

End Sub


Sub test()
Dim errorData512 As String
Dim errorData512_2 As String
Dim errorData As String
Dim tmpArray As Variant
Dim errorStringArray(0 To DATA_COL - 1) As String
'Dim tmpIntArray(0 To BYTE_NUM - 1) As Integer
Dim tmpIntArray As Variant
Dim errorArray(0 To BYTE_NUM - 1, 0 To DATA_COL - 1) As Long
Dim i As Long
Dim j As Long
'配列
Dim t(0 To DATA_MINUTE - 1) As String
Dim errorNum As Long
Dim rpm_fl_memo(0 To DATA_MINUTE - 1) As Long
Dim sitsuon(0 To DATA_MINUTE - 1) As Long
Dim nainetu(0 To DATA_MINUTE - 1) As Long
Dim tosyutu(0 To DATA_MINUTE - 1) As Long
Dim gainetu(0 To DATA_MINUTE - 1) As Long
Dim gaikion(0 To DATA_MINUTE - 1) As Long
Dim heatsink(0 To DATA_MINUTE - 1) As Long
Dim fan_rrpm(0 To DATA_MINUTE - 1) As Long
Dim dc_volt_pam(0 To DATA_MINUTE - 1) As Long
Dim denryuu(0 To DATA_MINUTE - 1) As Long
Dim tmi_compon(0 To DATA_MINUTE - 1) As Long
Dim fd_dmode(0 To DATA_MINUTE - 1) As Long
Dim infan(0 To DATA_MINUTE - 1) As Long
Dim rpm_sr(0 To DATA_MINUTE - 1) As Long
Dim rpm_pcon(0 To DATA_MINUTE - 1) As Long
Dim rpm_hcon(0 To DATA_MINUTE - 1) As Long
Dim nihoben(0 To DATA_MINUTE - 1) As Long
Dim suction(0 To DATA_MINUTE - 1) As Long
Dim fan_arpm(0 To DATA_MINUTE - 1) As Long
Dim pcon_level(0 To DATA_MINUTE - 1) As Long
Dim aA_stm_aabs(0 To DATA_MINUTE - 1) As Long
Dim rB_stm_aabs(0 To DATA_MINUTE - 1) As Long
Dim target_sh(0 To DATA_MINUTE - 1) As Long
Dim target_sh_sub(0 To DATA_MINUTE - 1) As Long
'こっちのほうがいい?
Dim graphElArray(0 To ELEM_NUMS - 1, 0 To DATA_MINUTE - 1) As Long
'いや、こっち?
Dim graphElDic As Object
Dim el_name As String
Dim y_first(0 To DATA_MINUTE - 1) As Long   'グラフ第1Y軸のデータを一時的に格納する
Dim y_second(0 To DATA_MINUTE - 1) As Long  'グラフ第2Y軸のデータを一時的に格納する
Dim y_first_num As Long                     '第1軸に表示する要素数
Dim y_second_num As Long                    '第2軸に表示する要素数
Dim y_i As Long

Set graphElDic = CreateObject("Scripting.Dictionary")

    graphElDic.Add "コンプ回転数", GraphElements.コンプ回転数
    graphElDic.Add "室温", GraphElements.室温
    graphElDic.Add "内熱交温度", GraphElements.内熱交温度
    graphElDic.Add "吐出温度", GraphElements.吐出温度
    graphElDic.Add "外熱交温度", GraphElements.外熱交温度
    graphElDic.Add "外気温", GraphElements.外気温
    graphElDic.Add "ヒートシンク温度", GraphElements.ヒートシンク温度
    graphElDic.Add "ファン回転数", GraphElements.ファン回転数
    graphElDic.Add "DC電圧", GraphElements.DC電圧
    graphElDic.Add "電流値", GraphElements.電流値
    graphElDic.Add "コンプON時間", GraphElements.コンプON時間
    graphElDic.Add "FD", GraphElements.FD
    graphElDic.Add "内ファン", GraphElements.内ファン
    graphElDic.Add "目標コンプ回転数", GraphElements.目標コンプ回転数
    graphElDic.Add "ピーコン", GraphElements.ピーコン
    graphElDic.Add "暖房ピーコン", GraphElements.暖房ピーコン
    graphElDic.Add "二方弁温度", GraphElements.二方弁温度
    graphElDic.Add "サクション温度", GraphElements.サクション温度
    graphElDic.Add "目標ファン回転数", GraphElements.目標ファン回転数
    graphElDic.Add "ピーコンレベル", GraphElements.ピーコンレベル
    graphElDic.Add "A膨張弁開度", GraphElements.A膨張弁開度
    graphElDic.Add "B膨張弁開度", GraphElements.B膨張弁開度
    graphElDic.Add "目標SH", GraphElements.目標SH
    graphElDic.Add "目標SHsub", GraphElements.目標SHsub

'###### ファイル読み込みと成形 ######
    'errorData512 = "00000000000000000000000000000000" & vbCrLf & "10000000000000000000000000000000" & vbCrLf & "20000000000000000000000000000000" & vbCrLf & _
                        "30000000000000000000000000000000" & vbCrLf & "40000000000000000000000000000000" & vbCrLf & "50000000000000000000000000000000" & vbCrLf & _
                        "60000000000000000000000000000000" & vbCrLf & "70000000000000000000000000000000" & vbCrLf & _
                        "80000000000000000000000000000000" & vbCrLf & "90000000000000000000000000000000" & vbCrLf & _
                        "00000000000000000000000000000000" & vbCrLf & "10000000000000000000000000000000" & vbCrLf & _
                        "20000000000000000000000000000000" & vbCrLf & "30000000000000000000000000000000" & vbCrLf & _
                        "40000000000000000000000000000000" & vbCrLf & "50000000000000000000000000000000" & vbCrLf & _
                        "60000000000000000000000000000000" & vbCrLf & "70000000000000000000000000000000" & vbCrLf & _
                        "80000000000000000000000000000000" & vbCrLf & "90000000000000000000000000000000" & vbCrLf & _
                        "00000000000000000000000000000000" & vbCrLf & "10000000000000000000000000000000" & vbCrLf & _
                        "20000000000000000000000000000000" & vbCrLf & "30000000000000000000000000000000" & vbCrLf & _
                        "40000000000000000000000000000000" & vbCrLf & "50000000000000000000000000000000" & vbCrLf & _
                        "60000000000000000000000000000000" & vbCrLf & "70000000000000000000000000000000" & vbCrLf & _
                        "80000000000000000000000000000000" & vbCrLf & "90000000000000000000000000000000" & vbCrLf & _
                        "A0000000000000000000000000000000" & vbCrLf & "B0000000000000000000000000000000"

    errorData512 = "6D3E434DCE864232BF547C1E14EEE18D" & vbCrLf & "B49DBFD87EB64129B32794CA03F90A4B" & vbCrLf & "F0A330E136BD4A4FB6C0EECB082DD3AC" & vbCrLf & _
                        "86C32EE19F8642949A4E9F50A9ED7F5F" & vbCrLf & "71F40EB222F44F98A0F09D6DAB8887F5" & vbCrLf & "B508948B16A042459AEF2E23596C2084" & vbCrLf & _
                        "FBEEB9B63A0B47CA8E087E339B044BC5" & vbCrLf & "BE439F86C4864899843566420D66ACDB" & vbCrLf & _
                        "C6262F873C0040A9B810523F5621C1D5" & vbCrLf & "8DDD16D90CBC4FF0B2442F771860ADE2" & vbCrLf & _
                        "0CC055B4EAFC4A88ACB0FC20BB973608" & vbCrLf & "1E075DACDF8843E593F6385ACE35C0C0" & vbCrLf & _
                        "1D01D97B8ACE47DAB6659B3D5E2759FB" & vbCrLf & "F2B75C8B4864485182003199AAE0BAA0" & vbCrLf & _
                        "A575D9FDE1C94F37A559DB5814D73854" & vbCrLf & "D19BE2A152CC40ADB50F1E6CCB071A84" & vbCrLf & _
                        "888A7F74ADCB4065B35E8AC85BEC5B02" & vbCrLf & "5FF15E4F08E1439DB74571916EB65460" & vbCrLf & _
                        "7F944588BFCB459A87C2A2450E79271B" & vbCrLf & "3EED4720770444088E30D03E3AFB1BA5" & vbCrLf & _
                        "D5E64536065F4BA385F26F29791FCA59" & vbCrLf & "79BFD5BCB1C7416F9249BB23F3C2C0B8" & vbCrLf & _
                        "ECEAF964F3EC45AD96D93341D052E121" & vbCrLf & "4FE6BFD1818E4FCB80B0A35EBA416986" & vbCrLf & _
                        "D9BD79ACEF314BDAAE4FFF8856BDB50C" & vbCrLf & "73CCD40361E54C709FF0834E613A66B9" & vbCrLf & _
                        "3E45054861C74680AB03C8DDD0334577" & vbCrLf & "338BA67286CB4BFAB362B2E73AF9F6DC" & vbCrLf & _
                        "6A0845581DD64FAB9415D499906E67C5" & vbCrLf & "76E7E84044D842048C5FFE1233B3E293" & vbCrLf & _
                        "D62893FA793946A5B1654BB76903FE90" & vbCrLf & "6DC20B2279CD4D508069C01ADBD13B05"

    errorData = errorData512 & vbCrLf & errorData512 & vbCrLf & errorData512 & vbCrLf & errorData512


    tmpArray = Split(errorData, vbCrLf)

    For i = 0 To UBound(tmpArray)
    'errorStringArray -> (512byte分"00"String * 4列分 )
        'Debug.Print i, i Mod STRING_LINE_NUM, i \ STRING_LINE_NUM, tmpArray(i)
        errorStringArray(i \ STRING_LINE_NUM) = errorStringArray(i \ STRING_LINE_NUM) & tmpArray(i)
    Next i

    '512byte分"00"String*4列の配列tmpIntArrayの各列を、"00……00"から整数512個*4列の配列errorArrayに
    For j = 0 To UBound(errorStringArray)
        tmpIntArray = HexStr512ToIntArray(errorStringArray(j))
        For i = 0 To UBound(tmpIntArray)
            errorArray(i, j) = tmpIntArray(i)
        Next i
    Next j

'###### グラフ用配列に格納 ######
    'errorArray(i Mod STRING_LINE_NUM, i \ STRING_LINE_NUM) = tmpArray(i)
    errorNum = CLng(Sheets("Sheet1").Cells(2, 2).Text)  'シートからエラー記憶番号を取得
    'For j = 0 To DATA_MINUTE - 1
    For j = DATA_MINUTE - 1 To 0 Step -1
        '15分の分のデータが記憶されてない場合の処理、なんかいる? 0になるだけか?
        t(j) = CStr(DATA_MINUTE - j) & "分前"
        For i = 0 To BYTE_NUM - 1 Step STRING_LINE_NUM
            rpm_fl_memo(j) = errorArray(i + 1, errorNum) + 256 + errorArray(i + 2, errorNum)
            sitsuon(j) = errorArray(i + 3, errorNum)
            nainetu(j) = errorArray(i + 4, errorNum)
            tosyutu(j) = errorArray(i + 5, errorNum)
            gainetu(j) = errorArray(i + 6, errorNum)
            gaikion(j) = errorArray(i + 7, errorNum)
            heatsink(j) = errorArray(i + 8, errorNum)
            fan_rrpm(j) = errorArray(i + 9, errorNum)
            dc_volt_pam(j) = errorArray(i + 10, errorNum)
            denryuu(j) = errorArray(i + 11, errorNum)
            tmi_compon(j) = errorArray(i + 12, errorNum) * 256 + errorArray(i + 13, errorNum)
            fd_dmode(j) = errorArray(i + 14, errorNum)
            infan(j) = errorArray(i + 15, errorNum)
            rpm_sr(j) = errorArray(i + 16, errorNum) * 256 + errorArray(i + 17, errorNum)
            rpm_pcon(j) = errorArray(i + 18, errorNum) * 256 + errorArray(i + 19, errorNum)
            rpm_hcon(j) = errorArray(i + 20, errorNum) * 256 + errorArray(i + 21, errorNum)
            nihoben(j) = errorArray(i + 22, errorNum)
            suction(j) = errorArray(i + 23, errorNum)
            fan_arpm(j) = errorArray(i + 24, errorNum)
            pcon_level(j) = errorArray(i + 25, errorNum)
            aA_stm_aabs(j) = errorArray(i + 26, errorNum)
            rB_stm_aabs(j) = errorArray(i + 27, errorNum)
            target_sh(j) = errorArray(i + 28, errorNum)
            target_sh_sub(j) = errorArray(i + 29, errorNum)
            'こっちのほうがいい?
            graphElArray(graphElDic.Item("コンプ回転数"), j) = errorArray(i + 1, errorNum) + 256 + errorArray(i + 2, errorNum)
            graphElArray(graphElDic.Item("室温"), j) = errorArray(i + 3, errorNum)
            graphElArray(graphElDic.Item("内熱交温度"), j) = errorArray(i + 4, errorNum)
            graphElArray(graphElDic.Item("吐出温度"), j) = errorArray(i + 5, errorNum)
            graphElArray(graphElDic.Item("外熱交温度"), j) = errorArray(i + 6, errorNum)
            graphElArray(graphElDic.Item("外気温"), j) = errorArray(i + 7, errorNum)
            graphElArray(graphElDic.Item("ヒートシンク温度"), j) = errorArray(i + 8, errorNum)
            graphElArray(graphElDic.Item("ファン回転数"), j) = errorArray(i + 9, errorNum)
            graphElArray(graphElDic.Item("DC電圧"), j) = errorArray(i + 10, errorNum)
            graphElArray(graphElDic.Item("電流値"), j) = errorArray(i + 11, errorNum)
            graphElArray(graphElDic.Item("コンプON時間"), j) = errorArray(i + 12, errorNum) * 256 + errorArray(i + 13, errorNum)
            graphElArray(graphElDic.Item("FD"), j) = errorArray(i + 14, errorNum)
            graphElArray(graphElDic.Item("内ファン"), j) = errorArray(i + 15, errorNum)
            graphElArray(graphElDic.Item("目標コンプ回転数"), j) = errorArray(i + 16, errorNum) * 256 + errorArray(i + 17, errorNum)
            graphElArray(graphElDic.Item("ピーコン"), j) = errorArray(i + 18, errorNum) * 256 + errorArray(i + 19, errorNum)
            graphElArray(graphElDic.Item("暖房ピーコン"), j) = errorArray(i + 20, errorNum) * 256 + errorArray(i + 21, errorNum)
            graphElArray(graphElDic.Item("二方弁温度"), j) = errorArray(i + 22, errorNum)
            graphElArray(graphElDic.Item("サクション温度"), j) = errorArray(i + 23, errorNum)
            graphElArray(graphElDic.Item("目標ファン回転数"), j) = errorArray(i + 24, errorNum)
            graphElArray(graphElDic.Item("ピーコンレベル"), j) = errorArray(i + 25, errorNum)
            graphElArray(graphElDic.Item("A膨張弁開度"), j) = errorArray(i + 26, errorNum)
            graphElArray(graphElDic.Item("B膨張弁開度"), j) = errorArray(i + 27, errorNum)
            graphElArray(graphElDic.Item("目標SH"), j) = errorArray(i + 28, errorNum)
            graphElArray(graphElDic.Item("目標SHsub"), j) = errorArray(i + 29, errorNum)
        Next i
    Next j
    'コンプ回転数,室温, 内熱交温度, 吐出温度, 外熱交温度, 外気温, ヒートシンク温度, ファン回転数, DC電圧, 電流値, コンプON時間, FD, 内ファン, 目標コンプ回転数, ピーコン, 暖房ピーコン,二方弁温度, サクション温度, 目標ファン回転数, ピーコンレベル, A膨張弁開度, B膨張弁開度, 目標SH, 目標SHsub



    '第1軸と第2軸の候補取得
    '第1軸
    If ActiveSheet.Cells(FIRST_ROW, FIRST_COL).Text = "" Then
        End '表示する要素がないから終了
    ElseIf ActiveSheet.Cells(FIRST_ROW + 1, FIRST_COL).Text = "" Then
        y_first_num = FIRST_ROW
    Else
        y_first_num = ActiveSheet.Cells(FIRST_ROW, FIRST_COL).End(xlDown).Row
    End If
    '第2軸
    If ActiveSheet.Cells(FIRST_ROW, FIRST_COL + 1).Text = "" Then
        y_second_num = FIRST_ROW - 1
    ElseIf ActiveSheet.Cells(FIRST_ROW + 1, FIRST_COL + 1).Text = "" Then
        y_second_num = FIRST_ROW
    Else
        y_second_num = ActiveSheet.Cells(FIRST_ROW, FIRST_COL + 1).End(xlDown).Row
    End If

    'グラフ作成
    '空のグラフ作成
    With ActiveSheet.ChartObjects.Add(ActiveSheet.Cells(FIRST_ROW + 5, 1).Left, ActiveSheet.Cells(FIRST_ROW + 5, 1).Top, GRAPH_WIDTH, GRAPH_HEIGHT).Chart
        .ChartType = xlLine '折れ線グラフ
        'データ系列作成
        '第1軸
        For i = FIRST_ROW To y_first_num
            el_name = ActiveSheet.Cells(i, FIRST_COL).Text
            For y_i = 0 To DATA_MINUTE - 1
                y_first(y_i) = graphElArray(graphElDic.Item(el_name), y_i)
            Next y_i
            With .SeriesCollection.NewSeries
                '.ChartType = xlLine '折れ線グラフ
                .XValues = t
                .Values = y_first
                .Name = el_name
            End With

        Next i
        '第2軸
        If y_second_num >= FIRST_ROW Then
            For i = FIRST_ROW To y_second_num
                el_name = ActiveSheet.Cells(i, FIRST_COL + 1).Text
                For y_i = 0 To DATA_MINUTE - 1
                    y_second(y_i) = graphElArray(graphElDic.Item(el_name), y_i)
                Next y_i
                With .SeriesCollection.NewSeries
                    '.ChartType = xlLine '折れ線グラフ
                    .XValues = t
                    .Values = y_second
                    .Name = el_name
                    .AxisGroup = xlSecondary '第2軸に
                End With
            Next i
        End If
    End With

    'プロットエリアの内部サイズ揃える
    With ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Chart
        .Legend.Position = xlLegendPositionTop
        'Debug.Print .PlotArea.InsideWidth
        .PlotArea.InsideLeft = GRAPH_WIDTH * 0.05 '30 '(.ChartArea.Width - .PlotArea.Width) / 2
        .PlotArea.InsideTop = GRAPH_HEIGHT * 0.1 '30 '(.ChartArea.Height - .PlotArea.Height) / 2
        .PlotArea.InsideWidth = GRAPH_WIDTH * 0.85
        .PlotArea.InsideHeight = GRAPH_HEIGHT * 0.85
    End With

End Sub
0
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
3