Embedded Files
Hello
Sub MakeGraph5(ByVal k As Long, ByRef ws1 As Worksheet, _
ByRef ws2 As Worksheet, ByRef ws3 As Worksheet)
'ws1 = "amc_......"
'ws2 = "list_......"
'ws3 = "newgraph"
Rem 縦書きへの変更
Dim i As Long, j As Long, i1 As Long, i2 As Long, i3 As Long, i4 As Long
Dim n As Long
Dim ws0 As Worksheet
Dim k1 As Long, k2 As Long, k3 As Long
Dim msg As String
Dim i5 As Long, GraphData_i As Long, GraphData_j As Long, Data_rg As Range, Data_wb As Workbook
Dim ws_ReadMe As Worksheet
Dim s1 As String, s2 As String, s3 As String
Dim ss As Variant
Dim ii As Variant, nn As Long
Dim i0 As Long, j0 As Long
Dim rg As Range
Dim cht As Chart
Dim Ic(8) As Double
Dim ws4 As Worksheet
Dim wb As Workbook
Dim flg2 As Long
Dim a As Long
Set wb = ws3.Parent
Set ws4 = wb.Worksheets("Summary")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ss = Array("GraphParameter", "SerBaseNum", "SerSkipNum", "SerDataNum", "TagLine")
nn = UBound(ss) - LBound(ss) + 1
ReDim ii(nn)
For i = 0 To nn - 1
Call SetParamWS(ss(i), ws3)
Next i
For i = 1 To nn - 1
'ii(i) = ws3.Names(ss(i)).RefersToRange.Value
ii(i) = ws3.Range(ss(i)).Value
Next i
'ReDim Ic(0, ii(2))
'i0 = ws3.Names("GraphParameter").RefersToRange.Row
'j0 = ws3.Names("GraphParameter").RefersToRange.Column
i0 = ws3.Range("GraphParameter").Row + 1
j0 = ws3.Range("GraphParameter").Column + 1
flg2 = 1
If チェックボックスの確認("マイナス側バイアスあります", ws3) = 1 Then
flg2 = 2
End If
i = 1 + ii(1) + ii(2) * (k - 1)
If i <= 0 Then
i = 1
End If
n = ws1.Cells(10, 7).End(xlDown).Row 'ws1 = "amc_......" '最大のデータ数
For k2 = 0 To ii(2) - 1
j = ws2.Cells(i + k2, ii(4)).Value 'ws2 = "list_......"
If j < 9 Then
msg = "Error in (" + ws2.Name + ")" + vbLf + vbCr
msg = "Row number = " + Format(i + i2 - 1, "0") + vbLf + vbCr
msg = "Column number = " + Format(i4, "0") + vbLf + vbCr
msg = "Value = " + Format(j, "0") + " < 9" + vbLf + vbCr
MsgBox msg
Call DescribeErrorCode(ws3, k, msg, 1)
Exit Sub
End If
If j > n Then
msg = "index of list_〇〇 file becomes over max row of amc_〇〇 file" + Format(j, "0") + "> n:" + Format(n, "0") + "(" + ws2.Name + ")" + "(" + ws1.Name + ")"
MsgBox msg
Call DescribeErrorCode(ws3, k, msg, -1)
Exit Sub
End If
ws3.Range(ws3.Cells(100 + k2, 1), ws3.Cells(100 + k2, 60)).Value = _
ws4.Range(ws4.Cells(i + k2 + 1, 1), ws4.Cells(i + k2 + 1, 60)).Value
For k = 0 To 3
Ic(k) = ws2.Cells(i + k2, ii(4) + 1 + k).Value 'Ic
Next k
If flg2 = 2 Then
For k = 4 To 7
Ic(k) = ws2.Cells(i + k2, ii(4) + 1 + k).Value 'Ic
Next k
End If
'マイナス側のデータがある場合には、4本のグラフを描くことになる
a = 2
If flg2 = 2 Then a = 4
ws3.Cells(i0 + k2 * a, j0).Value = j
ws3.Cells(i0 + k2 * a, j0 + 1).Value = j + ii(3) - 1
ws3.Cells(i0 + k2 * a + 1, j0).Value = j + ii(3)
ws3.Cells(i0 + k2 * a + 1, j0 + 1).Value = j + 2 * ii(3) - 1
ws3.Cells(i0 + k2 * a, j0 + 2).Value = Ic(0)
ws3.Cells(i0 + k2 * a, j0 + 3).Value = Ic(1)
ws3.Cells(i0 + k2 * a, j0 + 4).Value = ws1.Cells(j, 3).Value 'B
ws3.Cells(i0 + k2 * a, j0 + 5).Value = ws1.Cells(j, 4).Value 'T
ws3.Cells(i0 + k2 * a + 1, j0 + 2).Value = Ic(2)
ws3.Cells(i0 + k2 * a + 1, j0 + 3).Value = Ic(3)
ws3.Cells(i0 + k2 * a + 1, j0 + 4).Value = ws1.Cells(j + ii(3), 3).Value 'B
ws3.Cells(i0 + k2 * a + 1, j0 + 5).Value = ws1.Cells(j + 2 * ii(3) - 1, 4).Value 'T
If flg2 = 2 Then
ws3.Cells(i0 + k2 * a + 2, j0).Value = j + 2 * ii(3)
ws3.Cells(i0 + k2 * a + 2, j0 + 1).Value = j + 3 * ii(3) - 1
ws3.Cells(i0 + k2 * a + 3, j0 + 0).Value = j + 3 * ii(3)
ws3.Cells(i0 + k2 * a + 3, j0 + 1).Value = j + 4 * ii(3) - 1
ws3.Cells(i0 + k2 * a + 2, j0 + 2).Value = Ic(0)
ws3.Cells(i0 + k2 * a + 2, j0 + 3).Value = Ic(1)
ws3.Cells(i0 + k2 * a + 2, j0 + 4).Value = ws1.Cells(j + 2 * ii(3), 3).Value 'B
ws3.Cells(i0 + k2 * a + 2, j0 + 5).Value = ws1.Cells(j + 2 * ii(3), 4).Value 'T
ws3.Cells(i0 + k2 * a + 3, j0 + 2).Value = Ic(2)
ws3.Cells(i0 + k2 * a + 3, j0 + 3).Value = Ic(3)
ws3.Cells(i0 + k2 * a + 3, j0 + 4).Value = ws1.Cells(j + 3 * ii(3), 3).Value 'B
ws3.Cells(i0 + k2 * a + 3, j0 + 5).Value = ws1.Cells(j + 4 * ii(3) - 1, 4).Value 'T
End If
Next k2
k2 = ii(2)
ws3.Cells(i0 + k2 * a, j0).Value = "end"
Set cht = ws3.ChartObjects("メイングラフ").Chart
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Google Sites
Report abuse