vba线性差值求一定围压下孔隙比

Posted 2020-10-12

 1 Sub Chazhi()
 2 ‘ThisWorkbook.Worksheets("solveE").Active
 3 Dim PTotalRows As Integer, startRows As Integer
 4 Dim p, e, px, ex() As Double, Gs, PxTotalRows As Integer
 5 startRows = 4 ‘数据开始的行标
 6 PTotalRows = Range("a3").End(xlDown).Row ‘数据p列非空总行数
 7 PxTotalRows = Range("c3").End(xlDown).Row ‘‘数据px列非空总行数
 8 ReDim ex(1 To PxTotalRows - startRows + 1) ‘重新定义要求的e的数组大小
 9 p = Range(Cells(startRows, 1), Cells(PTotalRows, 1)) ‘将excel中p值读入数组
10 e = Range(Cells(startRows, 2), Cells(PTotalRows, 2))
11 px = Range(Cells(startRows, 3), Cells(PxTotalRows, 3))
12 ‘p = Range("a3:a" & totalRows)
13 ‘e = Range("b3:b" & totalRows)
14 
15 For i = 1 To PxTotalRows - startRows + 1 ‘遍历px
16 For j = 1 To PTotalRows - startRows ‘遍历p
17   If p(j, 1) < px(i, 1) And p(j + 1, 1) > px(i, 1) Then ‘观察px在哪两个p中间，那么就用这两个p和对应的e线性插值
18      ex(i) = ((px(i, 1) - p(j, 1)) / (p(j + 1, 1) - p(j, 1))) * (e(j + 1, 1) - e(j, 1)) + e(j, 1)
19      j = PTotalRows - startRows + 1 ‘插值完了再求下一个px对应的ex
20   End If
21   Next j
22 Next i
23 Range(Cells(startRows, 4), Cells(PxTotalRows, 4)) = Application.Transpose(ex)
24 End Sub