|
おはようございます。
ちょっと試してみたのですがなかなかうまくいかず・・・
今あるデータは、
Public Sub Search_Stress()
Dim Stress(80000), Max_Stress(5000), Min_Stress(5000) As Double
Dim Cycle(5000) As Integer
Dim Num_MaxData(5000), Num_MinData(5000), i As Long
Dim Row0, Val_Check, ii, j As Integer
Dim Num_LoopData, End_Cycle As Integer
Dim Dir_Load As Integer
Dim Dum As Variant
Row0 = 1
Num_LoopData = 200
i = 1
j = 1
Max_Stress(0) = 0
'----引張りで開始の意味----
Dir_Load = 1
Search:
Dum = Worksheets("Stress_Data").Cells(i + Row0, 1).Value
If Dum = "" Then GoTo Wr_Data
Stress(i) = Worksheets("Stress_Data").Cells(i + Row0, 1).Value
If Dir_Load = 1 Then GoTo Tension Else GoTo Compression
Tension:
If Stress(i) > Max_Stress(j) Then Max_Stress(j) = Stress(i) Else GoTo Check1
Num_MaxData(j) = i
GoTo Add_i
Check1:
Val_Check = Val_Check + 1
If Val_Check = 4 Then Cycle(j) = j: Val_Check = 0: Dir_Load = -1: Min_Stress(j) = Stress(i)
GoTo Add_i
Compression:
If Stress(i) < Min_Stress(j) Then Min_Stress(j) = Stress(i) Else GoTo Check2
Num_MinData(j) = i
GoTo Add_i
Check2:
Val_Check = Val_Check + 1
If Val_Check = 4 Then Val_Check = 0: j = j + 1: Dir_Load = 1: Max_Stress(j) = Stress(i)
GoTo Add_i
Add_i:
i = i + 1
GoTo Search
Wr_Data:
'----最大応力の妥当性のチェック-----
' If Num_MaxData(j) - Num_MaxData(j - 1) < Num_LoopData * 0.5 Then End_Cycle = j - 1
End_Cycle = j - 1
Worksheets("Cycle_vs_MaxSg").Cells(Row0, 1).Value = "Cycle"
Worksheets("Cycle_vs_MaxSg").Cells(Row0, 2).Value = "Max_Stress"
Worksheets("Cycle_vs_MaxSg").Cells(Row0, 3).Value = "Min_Stress"
For ii = 1 To End_Cycle
Worksheets("Cycle_vs_MaxSg").Cells(ii + Row0, 1).Value = Cycle(ii)
Worksheets("Cycle_vs_MaxSg").Cells(ii + Row0, 2).Value = Max_Stress(ii)
Worksheets("Cycle_vs_MaxSg").Cells(ii + Row0, 3).Value = Min_Stress(ii)
Next ii
End Sub
でA列にStressの値を入れて他のシートにCycle,Max_Stress,Min_Stressを書き出すというものです。それにプラスして抜き出したMax_Stress,Min_Stressの値と同じ行のB列の値も抜き出したいということです。
よろしければアドバイスお願いします。
|
|