使用excel 宏计算 ISO18437_6_CFS 计算表格,提示
需要怎样解决呢?
Sub CFS()
Dim i, j, k As Integer
'%%%%%% CLEAR DATA
Worksheets("Reduced segments").Cells.Clear
Dim index As Variant
index = Array(12, 24, 25, 29, 33)
Dim z As Integer
For i = 0 To 4
z = Worksheets("Main CFS").Cells(index(i), Worksheets("Main CFS").Columns.Count).End(xlToLeft).Column
z = z - 1
For k = 0 To z - 1
Worksheets("Main CFS").Cells(index(i), k + 2).Clear
Next k
Next i
Charts("Master curve").ChartArea.ClearContents
Charts("log aT").ChartArea.ClearContents
Charts("log bT").ChartArea.ClearContents
'%%%%%% ASSIGNING ARRAYS OF DATA
'Counting number of segments
Dim M As Integer
M = Worksheets("Main CFS").Cells(11, Worksheets("Main CFS").Columns.Count).End(xlToLeft).Column
M = M - 1
'Counting number of datum points in each segment
Dim N As Integer
N = Worksheets("Raw segments").Cells(Worksheets("Raw segments").Rows.Count, 1).End(xlUp).Row
N = N - 2
'Array of temperatures
Dim T As Variant
ReDim T(0 To M - 1) As Double
For j = 0 To M - 1
T(j) = Worksheets("Main CFS").Cells(11, j + 2) + 273.15
Next j
'Reference temperature
Dim ind As Integer
Dim Tref As Double
Tref = Worksheets("Main CFS").Cells(16, 2) + 273.15
ind = Application.Match(Tref, T, False)
ind = ind - 1
'Array of segments
Dim logE, logf As Variant
ReDim logE(0 To N - 1, 0 To M - 1), logf(0 To N - 1, 0 To M - 1) As Double
For j = 0 To M - 1
For i = 0 To N - 1
logE(i, j) = Worksheets("Raw segments").Cells(i + 3, 2 * (j + 1))
logf(i, j) = Worksheets("Raw segments").Cells(i + 3, 2 * j + 1)
Next i
Next j
'%%%%%% VERTICAL SHIFTING
'Vertical shift factors
Dim bT, log_bT As Variant
ReDim bT(0 To M - 1), log_bT(0 To M - 1) As Double
For j = 0 To M - 1
bT(j) = T(j) / Tref
log_bT(j) = Log(bT(j)) / Log(10)
Next j
'Reduced storage modulus segments
Dim logEr As Variant
ReDim logEr(0 To N - 1, 0 To M - 1) As Double
For j = 0 To M - 1
For i = 0 To N - 1
logEr(i, j) = logE(i, j) - log_bT(j)
Next i
Next j
'%%%%%% HORIZONTAL SHIFTING
'Individual horizontal shift factors
Dim lgf, lgE As Variant
ReDim lgf(0 To N - 1, 0 To M - 1), lgE(0 To N - 1, 0 To M - 1) As Double
Dim lg_aT As Variant
ReDim lg_aT(0 To M - 2) As Double
Dim P, Q, U, L, r, m1, m2 As Integer
Dim my_min, my_max, s1, s2 As Double
For j = 0 To M - 2
'Point Q
my_min = logEr(0, j)
Q = 0
'Point P
my_max = logEr(0, j + 1)
P = 0
For i = 1 To N - 1
If logEr(i, j) < my_min Then
my_min = logEr(i, j)
Q = i
End If
If logEr(i, j + 1) > my_max Then
my_max = logEr(i, j + 1)
P = i
End If
Next i
'Point U
U = Q
m1 = 0
Do While logEr(U, j) < my_max And U <= N - 1
U = U + 1
m1 = m1 + 1
Loop
'Point L
L = P
m2 = 0
Do While logEr(L, j + 1) > my_min And L >= 0
L = L - 1
m2 = m2 + 1
Loop
If m1 = 0 Or m2 = 0 Then
MsgBox "CHECK THE DATA!" & vbNewLine & "Some segments do not overlap"
lg_aT(j) = 1000
Else
'Point U
For r = Q To U - 1
lgf(r, j) = logf(r, j)
lgE(r, j) = logEr(r, j)
Next r
lgf(U, j) = logf(U - 1, j) + (my_max - logEr(U - 1, j)) * (logf(U, j) - logf(U - 1, j)) / (logEr(U, j) - logEr(U - 1, j))
lgE(U, j) = my_max
'Point L
For r = L + 1 To P
lgf(r, j + 1) = logf(r, j + 1)
lgE(r, j + 1) = logEr(r, j + 1)
Next r
lgf(L, j + 1) = logf(L - 1, j + 1) + (my_min - logEr(L - 1, j + 1)) * (logf(L, j + 1) - logf(L - 1, j + 1)) / (logEr(L, j + 1) - logEr(L - 1, j + 1))
lgE(L, j + 1) = my_min
'Individual shift factor
s1 = 0
For r = Q To U - 1
s1 = s1 + (lgf(r + 1, j) + lgf(r, j)) * (lgE(r + 1, j) - lgE(r, j)) / 2
Next r
s2 = 0
For r = L To P - 1
s2 = s2 + (lgf(r + 1, j + 1) + lgf(r, j + 1)) * (lgE(r + 1, j + 1) - lgE(r, j + 1)) / 2
Next r
lg_aT(j) = (s2 - s1) / (lgE(Q, j) - lgE(P, j + 1))
End If
Next j
'Final horizontal shift factors
Dim log_aT As Variant
ReDim log_aT(0 To M - 1) As Double
log_aT(ind) = 0
'Tk > Tref
For j = ind + 1 To M - 1
s1 = 0
For k = ind To j - 1
s1 = s1 + lg_aT(k)
Next k
log_aT(j) = log_aT(ind) + s1
Next j
'Tk < Tref
For j = ind - 1 To 0 Step -1
s2 = 0
For k = j To ind - 1
s2 = s2 + lg_aT(k)
Next k
log_aT(j) = log_aT(ind) - s2
Next j
'Reduced frequency
Dim logfr As Variant
ReDim logfr(0 To N - 1, 0 To M - 1) As Double
For j = 0 To M - 1
For i = 0 To N - 1
logfr(i, j) = logf(i, j) + log_aT(j)
Next i
Next j
'%%%%%% ASIGNING VALUES TO SHEET CELLS
'Temperature in K
For j = 0 To M - 1
Worksheets("Main CFS").Cells(12, j + 2).Value = T(j)
Next j
Worksheets("Main CFS").Cells(17, 2) = Tref
'Vertical shift factors
For j = 0 To M - 1
Worksheets("Main CFS").Cells(24, j + 2).Value = bT(j)
Worksheets("Main CFS").Cells(25, j + 2).Value = log_bT(j)
Next j
'Reduced storage modulus segments
Worksheets("Reduced segments").Rows(1).EntireRow.Value = Worksheets("Raw segments").Rows(1).EntireRow.Value
Worksheets("Reduced segments").Rows(1).Font.Bold = True
Worksheets("Reduced segments").Rows(2).EntireRow.Value = Worksheets("Raw segments").Rows(2).EntireRow.Value
Worksheets("Reduced segments").Rows(2).Interior.Color = RGB(146, 208, 80)
Worksheets("Reduced segments").Rows(2).Font.Bold = True
For j = 0 To M - 1
For i = 0 To N - 1
Worksheets("Reduced segments").Cells(i + 3, 2 * (j + 1)).Value = logEr(i, j)
Next i
Next j
Worksheets("Reduced segments").Columns.AutoFit
'Individual horizontal shift factors
For j = 0 To M - 2
Worksheets("Main CFS").Cells(29, j + 2).Value = lg_aT(j)
Next j
'Final horizontal shift factors
For j = 0 To M - 1
Worksheets("Main CFS").Cells(33, j + 2).Value = log_aT(j)
Next j
'Reduced frequency
For j = 0 To M - 1
For i = 0 To N - 1
Worksheets("Reduced segments").Cells(i + 3, 2 * j + 1).Value = logfr(i, j)
Next i
Next j
'%%%%%% PLOT RESULTS
'Master curve
Dim mcChart As Chart
Dim X_mc, Y_mc As Variant
ReDim X_mc(0 To N - 1), Y_mc(0 To N - 1) As Double
Set mcChart = Charts("Master curve")
With mcChart
'.Name = "Master curve"
.ChartType = xlXYScatterLines
.HasTitle = True
.ChartTitle.Text = "Master curve at Tref = " & Tref - 273.15 & Chr(176) & "C"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "log f, Hz"
.Axes(xlCategory).AxisTitle.Font.Size = 18
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "log M', Pa"
.Axes(xlValue).AxisTitle.Font.Size = 18
For j = 0 To M - 1
Set srs1 = .SeriesCollection.NewSeries
With srs1
For i = 0 To N - 1
X_mc(i) = Worksheets("Reduced segments").Cells(i + 3, 2 * j + 1)
Y_mc(i) = Worksheets("Reduced segments").Cells(i + 3, 2 * (j + 1))
Next i
.XValues = X_mc
.Values = Y_mc
.Name = "T = " & T(j) - 273.15 & Chr(176) & "C"
End With
Next j
.HasLegend = True
.Legend.Font.Size = 12
End With
'Horizontal shift factors
Dim hsChart As Chart
Dim X_hs, Y_hs As Variant
ReDim X_hs(0 To M - 1), Y_hs(0 To M - 1) As Double
Set hsChart = Charts("log aT")
With hsChart
.ChartType = xlXYScatterLines
.HasTitle = True
.ChartTitle.Text = "Horizontal shift factors at Tref = " & Tref - 273.15 & Chr(176) & "C"
.HasLegend = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "T, " & Chr(176) & "C"
.Axes(xlCategory).AxisTitle.Font.Size = 18
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "log aT"
.Axes(xlValue).AxisTitle.Font.Size = 18
Set srs2 = .SeriesCollection.NewSeries
With srs2
For j = 0 To M - 1
X_hs(j) = Worksheets("Main CFS").Cells(11, j + 2)
Y_hs(j) = Worksheets("Main CFS").Cells(33, j + 2)
Next j
.XValues = X_hs
.Values = Y_hs
End With
End With
'Vertical shift factors
Dim vsChart As Chart
Dim X_vs, Y_vs As Variant
ReDim X_vs(0 To M - 1), Y_vs(0 To M - 1) As Double
Set vsChart = Charts("log bT")
With vsChart
.ChartType = xlXYScatterLines
.HasTitle = True
.ChartTitle.Text = "Vertical shift factors at Tref = " & Tref - 273.15 & Chr(176) & "C"
.HasLegend = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "T, " & Chr(176) & "C"
.Axes(xlCategory).AxisTitle.Font.Size = 18
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "log bT"
.Axes(xlValue).AxisTitle.Font.Size = 18
Set srs3 = .SeriesCollection.NewSeries
With srs3
For j = 0 To M - 1
X_vs(j) = Worksheets("Main CFS").Cells(11, j + 2)
Y_vs(j) = Worksheets("Main CFS").Cells(25, j + 2)
Next j
.XValues = X_vs
.Values = Y_vs
End With
End With
End Sub