| |
まず最初にKeinさん、どうもありがとうございます。
多分Keinさんの方法で正しいのだと思うのですが、どうしてもうまく組めません。
本当にあつかましいのですが、マクロとデータを見て再度教えていただけませんか？
ごめんなさい。でもお願いします。
このマクロだと、6月3日と6月10日の横軸、縦軸が変更されていないのと
横軸目盛数値はストレイン値になっているのに、縦軸目盛数値は深度になっていません。
また6月3日と6月10日以外は、縦軸、横軸変更はされているような形なのですが、
各深度で作図されていません。規則性がつかめません。
＜マクロ＞
Dim inname
Dim outname
Dim WS As Worksheet
Dim myRange As Range
Dim ix1 As Integer
Dim ix2 As Integer
Dim ix3 As Integer
Dim ix1max As Integer
Dim vbnm As Variant
Dim maxgyo As Long
Dim maxretu As Long
Dim RUISA As Worksheet '累計差
Dim TATERUISA As Worksheet '縦累計差
中略
Sub exlread()
Dim genbanm As Variant
Dim year As Integer
Dim blocknm As Variant
Dim el(100) As Single
Dim yymm As Date
Dim data(100, 100) As Long
Dim gyo As Integer
Dim retu As Integer
Dim sheetno As Integer
Dim OBJ As Worksheet
' ------------> シートの数だけ処理
ix1 = 1
ix1max = Worksheets.Count
MsgBox "シート総枚数 = " & ix1max
Do While ix1 <= ix1max
' 新シート作成()
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ix2 = Worksheets.Count
Sheets(ix2).Select
Set RUISA = Workbooks(Dir(inname)).ActiveSheet
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ix3 = Worksheets.Count
Sheets(ix3).Select
Set TATERUISA = Workbooks(Dir(inname)).ActiveSheet
Sheets(ix1).Select
Set OBJ = Workbooks(Dir(inname)).ActiveSheet
' ------------> シート入力済み最終行を得る(=maxgyo)
maxgyo = Range("A1").CurrentRegion.Rows.Count
maxretu = Range("A1").CurrentRegion.Columns.Count
'
' ----------------------------------------------> データ加工処理
'
' ------------> シート固定ヘッダー部
genbanm = OBJ.Cells(1, 2)
year = OBJ.Cells(2, 2)
blocknm = OBJ.Cells(3, 2)
vbnm = OBJ.Cells(4, 2)
retu = 2
' ------------> 最終列迄処理
Do While retu <= maxretu
gyo = 6
' ------------> 最終行迄処理
Do While gyo <= maxgyo
If IsNumeric(OBJ.Cells(gyo, retu)) = True Then
data(gyo, retu) = OBJ.Cells(gyo, retu)
If data(gyo, retu) = 99999 Then
data(gyo, retu) = data(gyo, (retu - 1))
End If
End If
gyo = gyo + 1
Loop '1列の処理END
retu = retu + 1
Loop '1シート終了
'
' -------------------------------------------> 累差計算処理
'以下処理はシート上のどこかに数値が無いとグラフが書けないのだと思い作成しました。
retu = 3
' ------------> 最終列迄処理
Do While retu <= maxretu
RUISA.Cells(5, retu) = OBJ.Cells(5, retu)
RUISA.Cells(5, retu).NumberFormatLocal = "m""月""d""日"""
gyo = 6
' ------------> 最終行迄処理
Do While gyo <= maxgyo
RUISA.Cells(gyo, 2) = OBJ.Cells(gyo, 1)
RUISA.Cells(gyo, retu) = (data(gyo, retu) - data(gyo, 2))
gyo = gyo + 1
Loop '1列の処理END
' MsgBox "行条件パス " & gyo
retu = retu + 1
Loop '1シート終了
' --------------> グラフ作成
graph1draw
ix1 = ix1 + 1 '1シート処理終了
Loop 'Do While ix1 <= ix1max
End Sub
Function graph1draw()
Dim XV As Variant, V As Variant
Dim ix4 As Integer
Sheets(ix2).Select
' ------------> シート最終行を得る(=maxgyo)
maxgyo = Range("B6").CurrentRegion.Rows.Count
maxretu = Range("B6").CurrentRegion.Columns.Count
Set GRP1 = ActiveSheet.ChartObjects.Add(0, 0, 500, 400)
GRP1.Chart.SetSourceData _
Source:=ActiveSheet.Range(Cells(Range("B65536").End(xlUp).Row, Range("IV5").End(xlToLeft).Column), _
Cells(Range("C1").End(xlDown).Row, Range("A6").End(xlToRight).Column)), PlotBy:=xlColumns
GRP1.Chart.ChartType = xlXYScatterLines
ix4 = 3
Do While ix4 < (maxretu - 1)
With GRP1.Chart.SeriesCollection(ix4)
XV = .XValues
V = .Values
.XValues = V
.Values = XV
End With
ix4 = ix4 + 1
Loop
With GRP1.Chart
.HasTitle = True
.ChartTitle.Characters.Text = vbnm & " 歪 変 動 図"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "ストレイン"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "深度"
End With
With GRP1.Chart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With GRP1.Chart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
GRP1.Chart.HasDataTable = False
End Function
＜データ＞
カラムがあってなくてごめんなさい。
A B C D E F G
1
2
3
4
5 5月20日 5月27日 6月3日 6月10日 6月17日
6 1 -180 -100 -150 -170 -130
7 2 30 40 40 30 10
8 3 -80 -60 -90 -90 -60
9 4 -20 -20 30 -20 -10
10 5 -50 20 -50 -50 -40
11 6 -150 -70 -80 -100 -80
12 7 -120 -120 -30 -100 -40
13 8 30 30 20 0 10
14 9 -180 -170 -130 -270 -150
15 10 50 -20 -50 -30 -60
16 11 -170 -280 -30 -40 -10
17 12 270 270 180 -80 -80
18 13 -140 -140 -130 -70 -160
19 14 -130 -100 -100 -110 -90
20 15 -270 -300 -200 -230 -230
21 16 -230 -250 -170 -290 -220
22 17 0 0 0 0 0
23 18 -260 -250 -250 -300 -260
24 19 210 210 210 220 250
25 20 -20 -30 -30 -40 -30
26 21 120 70 130 130 150
27 22 -210 -190 -220 -170 -190
28 23 30 70 80 60 120
29 24 650 720 470 420 470
30 25 -40 180 270 290 300
31 26 30 10 20 0 30
32 27 0 -10 -30 -30 -30
33 28 230 250 280 230 230
34 29 910 930 940 860 980
35 30 -30 0 -10 0 10
36 31 3600 3690 3620 3570 3640
37 32 -1870 -1810 -1830 -1870 -1810
38 33 -160 -120 -130 -120 -130
39 34 -1300 -1350 -1310 -1300 -1300
40 35 -1180 -1280 -1280 -1280 -1280
深度(B) ストレイン(C)→
これだけの情報でわかっていただけるでしょうか？不足があれば言って下さい。
長々とすいません。どうかお願いいたします。
|
|
