excel运行提示运行错误9,下标越界,怎么处理

该宏代码用于清理数据、分配数据数组、进行垂直和水平位移计算,以及生成ISO18437_6_CFS相关的图表,如主曲线、水平位移因子和垂直位移因子图表。在处理过程中,检查数据段是否重叠,并对不重叠的情况给出警告。
摘要由CSDN通过智能技术生成

 使用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

 

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值