一、结构整体控制
我们常常根据高规、抗规对结构的整体参数进行概念设计上判断整体规则性，比如常常说到的刚度比等几个比，如下图介绍，控制平面规则、竖向规则、强度刚度稳定性、延性、地震力等。
注意上图中地震影响系数的原点有误。
二、结构整体参数结果读取
在yjk软件中，wmass、wzq、wdisp是常需查阅的文件，几乎包括所有信息，为此设计一张表格，快速检校其中的数据很有必要。如下图表所示：
读取数据形成数据表
通过数据生成简易图表
三、VBA代码实现
VBA实现思路是，读取文件所有行，判断行内容，并填入数据表。思路简单，代码800多行，竟也花了两三天，开源之，分享以输出价值。欢迎同行分享并优化升级。
Sub SelectFile()
Dim FileName As Variant
'打开文件对话框返回的文件名，是一个全路径文件名，其值也可能是False，因此类型为Variant
Dim sFileName As String '从FileName中提取的文件名
Dim sPathName As String '从FileName中提取的路径名
Dim aFile As Variant '数组，提取文件名sFileName时使用
Dim ws As Worksheet '存储文件路径名和文件名的工作表
Set ws = Worksheets("Sheet1") '设置工作表
FileName = Application.GetOpenFilename("wmass 文件 (*.out),*.out")
'调用Windows打开文件对话框
If FileName <> False Then '如果未按“取消”键
aFile = Split(FileName, "\") '在全路径中，以“/”为分隔符，分成数据
sPathName = aFile(0) '取盘符
For i = 1 To UBound(aFile) - 1 '循环合成路径名
sPathName = sPathName & "\" & aFile(i)
Next
sFileName = aFile(UBound(aFile)) '数组的最后一个元素为文件名
ws.Cells(1, 2).Value = sPathName '保存路径名
'ws.Cells(2, 2).Value = sFileName '保存文件名
ws.Cells(2, 2).Value = "wmass.out"
'SelectFile = sFileName
End If
End Sub '选择打开文件后并没有真实的把它打开。
Sub bb()
Dim a, b, k%, i%, j%, q%
nn = 100
Worksheets("sheet1").Range("b3:v" & nn).ClearContents
On Error GoTo e1
'filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\" & "wmass.out"
If Worksheets("Sheet1").Cells(1, 2).Value = "" Then
e1:
Call SelectFile
End If
filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\" & "wmass.out"
Open filename1 For Input As #1
a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1
k = UBound(a)
flag1 = False
flag2 = False
plotorih = 800
dataorilinen = 6
For i = 0 To k
temp = Application.Trim(a(i))
'''
If temp = "楼层属性" Then
flag1 = True '层号相应标志
j = 0 '取各层计数
i = i + 2
GoTo fff
End If
If flag1 Then
If temp = "" Then '终止，并归零标志
myfloors = j - 1
flag1 = False
j = 0
GoTo fff
End If
b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 2).Value = b(0)
'Worksheets("Sheet1").Cells(dataorilinen + j, 3).Value = b(1)
j = j + 1
End If
'''
'''
If temp = "各层构件数量、构件材料和层高" Then
flag1a = True '层号相应标志
j = 0 '取各层计数
i = i + 2
GoTo fff
End If
If flag1a Then
If temp = "" Then '终止，并归零标志
GoTo fff
End If
If j >= myfloors Then
flag1a = False
End If
b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 3).Value = b(6)
'Worksheets("Sheet1").Cells(dataorilinen + j, 3).Value = b(1)
j = j + 1
End If 'flag1a
'''
'''
If temp = "各楼层质量、单位面积质量分布(单位:kg/m**2)" Then
flag2 = True '层号相应标志
j = 0 '取各层计数
i = i + 2
GoTo fff
End If
If flag2 Then
If temp = "" Then '终止，并归零标志
flag2 = False
j = 0
GoTo fff
End If
b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 4).Value = b(3)
Worksheets("Sheet1").Cells(dataorilinen + j, 5).Value = b(4)
j = j + 1
End If 'flag2
'''
If temp = "各层刚心、偏心率、相邻层侧移刚度比等计算信息" Then
flag3 = True '层号相应标志
j = 0 '取各层计数
Worksheets("Sheet1").Cells(dataorilinen + j, 6).Value = "Ratx1="
Worksheets("Sheet1").Cells(dataorilinen + j, 7).Value = "Raty1="
Worksheets("Sheet1").Cells(dataorilinen + j, 8).Value = "Ratx2="
Worksheets("Sheet1").Cells(dataorilinen + j, 9).Value = "Raty2="
j = j + 1
i = i + 13
GoTo fff
End If
If flag3 Then
If temp = "" Then '终止，并归零标志
flag3 = False
j = 0
GoTo fff
End If
b = Split(temp, " ")
If b(0) = "Ratx1=" Then
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 6).Value = b(1)
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 7).Value = b(3)
GoTo fff
End If
If b(0) = "Ratx2=" Then
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 8).Value = b(1)
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 9).Value = b(3)
j = j + 1
GoTo fff
End If
If b(0) = "X方向最小刚度比:" Then
Worksheets("Sheet1").Cells(dataorilinen - 2, 8).Value = b(0)
Worksheets("Sheet1").Cells(dataorilinen - 1, 8).Value = b(1)
temp = Application.Trim(a(i + 1))
b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen - 2, 9).Value = b(0)
Worksheets("Sheet1").Cells(dataorilinen - 1, 9).Value = b(1)
i = i + 1
GoTo fff
End If
End If 'flag3
'''
'''
If temp = "结构整体稳定验算" Then
flag4 = True '层号相应标志
j = 0 '取各层计数
i = i + 6
GoTo fff
End If
If flag4 Then
If temp = "" Then '终止，并归零标志
flag4 = False
j = 0
GoTo fff
End If
Worksheets("Sheet1").Cells(dataorilinen + j, 10).Value = temp
j = j + 1
End If 'flag2
'''
'''
If temp = "楼层抗剪承载力验算" Then
flag5 = True '层号相应标志
j = 0 '取各层计数
i = i + 4
GoTo fff
End If
If flag5 Then
If temp = "" Then '终止，并归零标志
flag5 = False
j = 0
GoTo fff
End If
b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 11).Value = b(4)
Worksheets("Sheet1").Cells(dataorilinen + j, 12).Value = b(5)
j = j + 1
End If 'flag2
'''
fff:
Next i
'周期地震力文件
filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\wzq.out"
Open filename1 For Input As #1
a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1
k = UBound(a)
flag6 = False
flag7 = -1
flag8 = False
For i = 0 To k
temp = Application.Trim(a(i))
'''
If temp = "周期、地震力与振型输出文件" Then
flag6 = True '层号相应标志
j = 0 '取各层计数
i = i + 4
GoTo ggg
End If
If flag6 Then
'跳过一行
If temp = "" Then
GoTo ggg
End If
b = Split(temp, " ")
If j < 6 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 13).Value = b(1)
Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(3)
j = j + 1
ElseIf b(0) = "X向平动振型参与质量系数总计:" Then
flag7 = 3
End If ' j<6
If flag7 > 1 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 13).Value = b(0)
Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(1)
flag7 = flag7 - 1
j = j + 1
ElseIf flag7 > 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 13).Value = b(0)
Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(2)
flag7 = flag7 - 1
j = j + 1
ElseIf flag7 = 0 Then
flag6 = False
flag7 = flag7 - 1
j = 0
End If 'flag7
End If 'flag6
'''
'''
If temp = "各层 X 方向的作用力(CQC)" Then
flag8 = True '层号相应标志
j = 0 '取各层计数
i = i + 7
GoTo ggg
End If
If flag8 Then
If j >= myfloors + 2 Then '终止，并归零标志
flag8 = False
j = 0
GoTo ggg
End If
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 15).Value = "X 向剪重比"
j = j + 1
GoTo ggg
End If
If temp = "" Then
GoTo ggg
End If
If temp = "(kN) (kN) (kN-m) (kN)" Then
GoTo ggg
End If
b = Split(temp, "%")
If j <= myfloors Then
Worksheets("Sheet1").Cells(dataorilinen + j, 15).Value = Split(b(0), "(")(1) & "%"
'Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(3)
j = j + 1
Else
Worksheets("Sheet1").Cells(dataorilinen - 2, 15).Value = "X向楼层最小剪重比"
Worksheets("Sheet1").Cells(dataorilinen - 1, 15).Value = Split(b(0), "=")(1) & "%"
Worksheets("ref").Range("c1").Value = b(0)
Worksheets("ref").Range("c" & 1 + dataorilinen & ":c" & dataorilinen + myfloors).Value = Worksheets("Sheet1").Cells(dataorilinen - 1, 15).Value
j = j + 1
'flag8 = False
End If 'j
End If 'flag8
'''
'''
If temp = "各层 Y 方向的作用力(CQC)" Then
flag9 = True '层号相应标志
j = 0 '取各层计数
i = i + 7
GoTo ggg
End If
If flag9 Then
If j >= myfloors + 2 Then '终止，并归零标志
flag9 = False
j = 0
GoTo ggg
End If
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 16).Value = "Y 向剪重比"
j = j + 1
GoTo ggg
End If
If temp = "" Then
GoTo ggg
End If
If temp = "(kN) (kN) (kN-m) (kN)" Then
GoTo ggg
End If
b = Split(temp, "%")
'跳过一行
If j <= myfloors Then
Worksheets("Sheet1").Cells(dataorilinen + j, 16).Value = Split(b(0), "(")(1) & "%"
'Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(3)
j = j + 1
Else
Worksheets("Sheet1").Cells(dataorilinen - 2, 16).Value = "Y向楼层最小剪重比"
Worksheets("Sheet1").Cells(dataorilinen - 1, 16).Value = Split(b(0), "=")(1) & "%"
Worksheets("ref").Range("d1").Value = b(0)
Worksheets("ref").Range("d" & 1 + dataorilinen & ":d" & dataorilinen + myfloors).Value = Worksheets("Sheet1").Cells(dataorilinen - 1, 16).Value
j = j + 1
'flag9 = False
End If 'j
End If 'flag9
'''
ggg:
Next i
'位移输出文件
filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\wdisp.out"
Open filename1 For Input As #1
a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1
k = UBound(a)
flag10 = False
For i = 0 To k
temp = Application.Trim(a(i))
'''
If InStr(11, temp, "X 方向地震作用下的楼层最大位移") > 0 Then
flag10 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If
If flag10 Then
If j > myfloors Then '终止，并归零标志
flag10 = False
j = 0
End If
If temp = "" Then
i = i + 1
GoTo hhh
End If
b = Split(temp, " ")
'跳过一行
If b(0) = "X向最大层间位移角：" Then
Worksheets("Sheet1").Cells(dataorilinen - 1, 17).Value = a(i)
GoTo hhh
End If
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 17).Value = "X方向地震层间位移角"
j = j + 1
End If
If j <= myfloors Then
Worksheets("Sheet1").Cells(dataorilinen + j, 17).Formula = "=" & b(3)
i = i + 1 '跳一行
j = j + 1
End If 'j
End If 'flag10
'''
'''
If InStr(11, temp, "Y 方向地震作用下的楼层最大位移") > 0 Then
flag11 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If
If flag11 Then
If j > myfloors Then '终止，并归零标志
flag11 = False
j = 0
End If
If temp = "" Then
i = i + 1
GoTo hhh
End If
b = Split(temp, " ")
'跳过一行
If b(0) = "Y向最大层间位移角：" Then
Worksheets("Sheet1").Cells(dataorilinen - 1, 18).Value = a(i)
GoTo hhh
End If
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 18).Value = "Y方向地震层间位移角"
j = j + 1
End If
If j <= myfloors Then
Worksheets("Sheet1").Cells(dataorilinen + j, 18).Formula = "=" & b(3)
i = i + 1 '跳一行
j = j + 1
End If 'j
End If 'flag11
'''
'''
If InStr(11, temp, "+X 方向风荷载作用下的楼层最大位移") > 0 Then
flag12 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If
If flag12 Then
If j > myfloors Then '终止，并归零标志
flag12 = False
j = 0
End If
If temp = "" Then
i = i + 1
GoTo hhh
End If
b = Split(temp, " ")
'跳过一行
If b(0) = "X向最大层间位移角：" Then
Worksheets("Sheet1").Cells(dataorilinen - 1, 19).Value = a(i)
GoTo hhh
End If
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 19).Value = "+X 方向风荷载层间位移角"
j = j + 1
End If
If j <= myfloors Then
Worksheets("Sheet1").Cells(dataorilinen + j, 19).Formula = "=" & b(4)
i = i + 1 '跳一行
j = j + 1
End If 'j
End If 'flag12
'''
If InStr(11, temp, "+Y 方向风荷载作用下的楼层最大位移") > 0 Then
flag13 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If
If flag13 Then
If j > myfloors Then '终止，并归零标志
flag13 = False
j = 0
End If
If temp = "" Then
i = i + 1
GoTo hhh
End If
b = Split(temp, " ")
'跳过一行
If b(0) = "Y向最大层间位移角：" Then
Worksheets("Sheet1").Cells(dataorilinen - 1, 20).Value = a(i)
GoTo hhh
End If
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 20).Value = "+Y 方向风荷载层间位移角"
j = j + 1
End If
If j <= myfloors Then
If Right(b(4), 1) = "/" Then
Worksheets("Sheet1").Cells(dataorilinen + j, 20).Formula = "=" & b(4) & b(5)
Else
Worksheets("Sheet1").Cells(dataorilinen + j, 20).Formula = "=" & b(4)
End If 'right
i = i + 1 '跳一行
j = j + 1
End If 'j
End If 'flag13
'''
If InStr(11, temp, "X 方向规定水平力作用下的楼层最大位移") > 0 Then
flag14 = True '层号相应标志
j = 0 '取各层计数
jj = 0
i = i + 3
GoTo hhh
End If
If flag14 Then
If j = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + j, 21).Value = "X方向位移比"
j = j + 1
End If
If jj = 0 Then
Worksheets("Sheet1").Cells(dataorilinen + jj, 22).Value = "Y方向位移比"
jj = jj + 1
End If
If temp = "" Then
'i = i + 1
GoTo hhh
End If
b = Split(temp, " ")
If b(0) = "X方向最大层间位移与平均层间位移的比值：" Then
Worksheets("Sheet1").Cells(dataorilinen + j, 21).Value = b(1)
j = j + 1
GoTo hhh
End If
If b(0) = "Y方向最大层间位移与平均层间位移的比值：" Then
Worksheets("Sheet1").Cells(dataorilinen + jj, 22).Value = b(1)
jj = jj + 1
GoTo hhh
End If
End If 'flag14
'''
hhh:
Next i
'作图
plotorih = (dataorilinen + myfloors + 6) * 14.25
Set rng2 = Worksheets("sheet1").Range("b" & 1 + dataorilinen & ":b" & dataorilinen + myfloors)
mycoln = "d"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
'Set rng4 = Worksheets("ref").Range("a4:a" & 3 + myfloors)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot(0, rng1, rng2, rng3, plotorih)
Set rng4 = Worksheets("ref").Range("a" & 1 + dataorilinen & ":a" & dataorilinen + myfloors)
mycoln = "f"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(1, rng1, rng2, rng3, rng4, plotorih)
mycoln = "g"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(2, rng1, rng2, rng3, rng4, plotorih)
'Set rng4 = Worksheets("ref").Range("b4:a" & 3 + myfloors)
mycoln = "h"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(3, rng1, rng2, rng3, rng4, plotorih)
mycoln = "i"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(3, rng1, rng2, rng3, rng4, plotorih)
Set rng4 = Worksheets("ref").Range("b" & 1 + dataorilinen & ":b" & dataorilinen + myfloors)
mycoln = "k"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(4, rng1, rng2, rng3, rng4, plotorih)
mycoln = "l"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(5, rng1, rng2, rng3, rng4, plotorih)
Set rng4 = Worksheets("ref").Range("c" & 1 + dataorilinen & ":c" & dataorilinen + myfloors)
mycoln = "o"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(0, rng1, rng2, rng3, rng4, plotorih, 1)
Set rng4 = Worksheets("ref").Range("d" & 1 + dataorilinen & ":d" & dataorilinen + myfloors)
mycoln = "p"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot2(1, rng1, rng2, rng3, rng4, plotorih, 1)
mycoln = "q"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot(2, rng1, rng2, rng3, plotorih, 1)
mycoln = "r"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot(3, rng1, rng2, rng3, plotorih, 1)
mycoln = "s"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot(4, rng1, rng2, rng3, plotorih, 1)
mycoln = "t"
Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
Call myplot(5, rng1, rng2, rng3, plotorih, 1)
'myplot (myfloors)
End Sub
Sub myplot(indexh As Integer, rng1, rng2, rng3, plotorih, Optional indexv As Integer = 0)
'
' 宏1 宏
On Error GoTo err:
Worksheets("sheet1").ChartObjects(rng3.Text).Delete '确保这是唯一的图
err:
'Set rng1 = Worksheets("sheet1").Range("d4:d" & 3 + myfloors)
'Set rng2 = Worksheets("sheet1").Range("b4:b" & 3 + myfloors)
' Set rng3 = Worksheets("sheet1").Range("D3")
Set ch = Worksheets("sheet1").ChartObjects.Add(50 + 200 * indexh, plotorih + indexv * 300, 200, 300)
ch.Name = rng3.Text
With ch.Chart
.ChartType = xlXYScatterLinesNoMarkers
'ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
'ActiveChart.SetSourceData Source:=Range("Sheet1!$D$4:$D$31,Sheet1!$B$4:$B$31")
.SeriesCollection.NewSeries '这个必须得有
.SeriesCollection(1).Values = rng2
.SeriesCollection(1).XValues = rng1
.SeriesCollection(1).Name = rng3.Text
End With
Set ch = Nothing
End Sub
Sub myplot2(indexh As Integer, rng1, rng2, rng3, rng4, plotorih, Optional indexv As Integer = 0)
'
' 宏1 宏
On Error GoTo err:
Worksheets("sheet1").ChartObjects(rng3.Text).Delete '确保这是唯一的图
err:
'Set rng1 = Worksheets("sheet1").Range("d4:d" & 3 + myfloors)
'Set rng2 = Worksheets("sheet1").Range("b4:b" & 3 + myfloors)
' Set rng3 = Worksheets("sheet1").Range("D3")
Set ch = Worksheets("sheet1").ChartObjects.Add(50 + 200 * indexh, plotorih + indexv * 300, 200, 300)
ch.Name = rng3.Text
With ch.Chart
.ChartType = xlXYScatterLinesNoMarkers
'ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
'ActiveChart.SetSourceData Source:=Range("Sheet1!$D$4:$D$31,Sheet1!$B$4:$B$31")
.SeriesCollection.NewSeries '这个必须得有
.SeriesCollection(1).Values = rng2
.SeriesCollection(1).XValues = rng1
.SeriesCollection(1).Name = rng3.Text
.SeriesCollection.NewSeries '这个必须得有
.SeriesCollection(2).Values = rng2
.SeriesCollection(2).XValues = rng4
.SeriesCollection(2).Name = "限值"
End With
Set ch = Nothing
End Sub
Sub minmax(coln, dataorilinen, myfloors, rng1)
Worksheets("Sheet1").Cells(dataorilinen + myfloors + 1, coln).Value = Application.Min(rng1)
Worksheets("Sheet1").Cells(dataorilinen + myfloors + 2, coln).Value = Application.Max(rng1)
End Sub
Sub mysplit()
filename1 = Worksheets("Sheet1").Cells(2, 2).Value
a = Split(filename1, "\")
End Sub
Sub saveold()
nn = 100
Application.ScreenUpdating = False '关闭屏幕刷新
Worksheets("temp").Range("b3:v" & nn).ClearContents
nn = Worksheets("sheet1").[D65535].End(xlUp).Row
Worksheets("sheet1").Range("b1:v" & nn).Copy Worksheets("temp").Range("b1:v" & nn)
Application.ScreenUpdating = True '打开屏幕刷新
End Sub
以上。
四、下载使用
点击生成按钮，将一键生成图表：自动更新非填充区数据，及简易图表，以便于快速查阅结构整体参数。切换项目目录仅需删除B1单元格数据，注意提示选择文件时，应选择wmass.out文件。本表格使用VBA，需要同意启动宏。
赞助作者请加微信hnuliulinhai，传递价值，共享快乐。
五、升级
工作表sheet1生成数据，按钮保存将sheet1工作表数据拷贝至工作表temp，工作表dif中可以查看上述两表的差别。按新调整过的模型结果生成数据，然后表dif中进行对应单元格比较，可以粗略判断调整模型后的变化。
六、注意
此表格仅为摘要，仍应多次查看原wmass等文件，避免以偏概全。
Last Modified·2018年4月7日 09:49
您尚未登录，请先登录才能评论。