帮忙看下应该怎么才能运行，这一段用Dcollection和Levelsection总是显示未定义

[qq_44941346]

'水准网平差类 LevelNet
Option Explicit
Dim qsd As New DCollection '起算点列表
Dim wzd As New DCollection '未知点列表
Dim sections() As New LevelSection '测段
Dim kNum As Integer '已知点数
Dim sNum As Integer '测段数
Dim msNum As Integer '必要观测数
Dim fDegree As Integer '自由度
Dim uWeight As Double '单位权
Dim uWeight0 As Double '先验单位权
Dim tDistance As Double '总距离数
Dim tPoints As Integer '总点数
Dim pvv As Double '用于精度评定
Const eps As Double = 0.00000001 '缺省精度
Private Function readQsd(dlist() As String) As DCollection '读取起算点数据
Dim bm As Benchmark, ds() As String, d As Variant, bs As New DCollection
For Each d In dlist
Set bm = New Benchmark
ds = Split(d, ",")
bm.id = UCase(ds(0))
bm.appH = Val(ds(1))
bm.known = True
If bs.ExistsKey(bm.id) = False Then
bs.Add bm, bm.id
End If
Next
Set readQsd = bs
End Function
Private Function readObs(dlist() As String) As LevelSection() '读取起算点数据
Dim ss() As New LevelSection, ds() As String, i As Integer, j As Integer
j = UBound(dlist)
ReDim ss(j) As New LevelSection
For i = 0 To j
ds = Split(dlist(1), ",")
ss(i).fromID = UCase(ds(0))
ss(i).toID = UCase(ds(1))
ss(i).Observe = Val(ds(2))
ss(i).Distance = Val(ds(3))
Next i
End Function
Private Function SplitLine(ByVal s As String) As String() '分解格式数据
s = Replace(s, Chr(9), " ")
s = Replace(s, " ", " ")
s = Replace(s, Chr(13), " ")
s = Replace(s, Chr(10), " ")
SplitLine Split(Trim(s))
End Function

Public Sub readData(ByVal obsText As String, qsdText As String, ByVal uw As String) '读取数据
Dim bs0 As DCollection '起算点列表
Set bs0 = readQsd(SplitLine(qsdText)) '读取起算点,必须先调用
sections = readObs(SplitLine(obsText)) '读取观测数据
uWeight0 = Val(uw)
Dim bm As Benchmark, s As Variant
For Each s In sections '根据观测数据构建水准点集合
Set bm = New Benchmark
bm.id = s.fromID
If bs0.ExistsKey(bm.id) And qsd.ExistsKey(bm.id) = False Then
bm , appH = bs0.Item(bm.id).appH
bm.adjH = bm.appH
bm.known = True
qsd.Add bm, bm.id
ElseIf bs0.ExistsKey(bm.id) = False And wzd.ExistsKey(bm.id) = False Then
bm.appH = -99999
bm.known = False
wzd.Add bm, bm.id
End If
Set bm = New Benchmark
bm.id = s.tolD
If bs0.ExistsKey(bm.id) And qsd.ExistsKey(bm.id) = False Then
bm.appH = bs0.Item(bm.id).appH
bm.adjH = bm.appH
bm.known = True
qsd.Add bm, bm.id
ElseIf bs0.ExistsKey(bm.id) = False And wzd.ExistsKey(bm.id) = False Then
bm.appH = -99999
bm.known = False
wzd.Add bm, bm.id
End If
Next
sNum = UBound(sections) + 1 '测段数
msNum = wzd.Count '必要观测数=总点数-已知点数
tPoints = kNum + msNum
fDegree = sNum - msNum '自由度=总测段数-必要观测数
End Sub
Public Property Get sectionNum()
sectionNum = UBound(sections) + 1 '测段数
End Property
Public Property Get mustNum()
mustNum = msNum '必要观测数
End Property
Public Property Get freeDegree()
freeDegree = fDegree '自由度=总测段数-必要观测数
End Property
Public Property Get unitWeight()
unitWeight = uWeight '单位权
End Property
Public Property Get totalDistance()
totalDistance = tDistance '总距离
End Property
Public Property Get totalPoints()
totalPoints = tPoints '单位权
End Property
Public Function calcApproximateAltitude() As Boolean '计算近似高程
Dim i As Integer
Dim bm1 As Benchmark, bm2 As Benchmark, s As Variant
For i = 0 To UBound(sections)
For Each s In sections
If qsd.ExistsKey(s.fromID) Then
Set bm1 = qsd.Item(s.fromID)
If wzd.ExistsKey(s.toID) Then
Set bm2 = wzd.Item(s.toID)
bm2.appH = bm1.appH + s.Observe
End If
ElseIf qsd.ExistsKey(s.toID) Then
Set bm2 = qsd.Item(s.toID)
If wzd.ExistsKey(s.fromID) Then
Set bm1 = wzd.Item(s.fromID)
bml.appH = bm2.appH - s.Observe
End If
Set bm1 = wzd.Item(s.fromID)
ElseIf wzd.ExistsKey(s.fromID) And wzd.ExistsKey(s.toID) Then
Set bm1 = wzd.Item(s.fromID)
Set bm2 = wzd.Item(s, .toID)
If (bm1.appH + 9999) > eps And (bm2.appH + 9999) < eps Then
bm2.appH = bm1.appH + s.Observe
ElseIf (bm1.appH + 9999) < eps And (bm2.appH + 9999) > eps Then
bml.appH = bm2.appH - s.Observe
End If
End If
Next
Next i '检测是否有水准点不能推算
For Each s In sections
If wzd.ExistsKey(s.fromID) Then
Set bm1 = wzd.Item(s.fromID)
If Abs(bml.appH + 9999) < eps Then
MsgBox s.fromID + s.toID + "测段中," + bm1.id + "水准点的近似高程不能推算,请检查观测数据。"
calcApproximateAltitude = False
Exit Function
End If
End If
If wzd.ExistsKey(s.toID) Then
Set bm2 = wzd.Item(s.toID)
If Abs(bm2.appH + 9999) < eps Then
MsgBox s.fromID + s.toID + "测段中," + bm2.id + "水准点的近似高程不能推算,请检查观测数据。"
calcApproximateAltitude = False
Exit Function
End If
End If
Next
calcApproximateAltitude = True
End Function
Public Sub buildBlP(mB As Matrix, mL As Matrix, mP As Matrix) '建立误差方程
mB.init sNum, msNum '误差方程系数矩阵
mL.init sNum, 1 'L系数矩阵
mP.init sNum, sNum '权矩阵
Dim bm1 As Benchmark, bm2 As Benchmark, s As LevelSection
Dim row As Integer
For row = 0 To sNum - 1
Set s = sections(row)
If qsd.ExistsKey(s.fromID) Then
Set bm1 = qsd.Item(s.fromID)
ElseIf wzd.ExistsKey(s.fromID) Then
Set bm1 = wzd.Item(s.fromID)
mB.Element(row, wzd.getindex(bm1, id) - 1) = -1
End If
If qsd.ExistsKey(s.toID) Then
Set bm2 = qsd.Item(s, toID)
ElseIf .wzd.ExistsKey(s.tolD) Then
Set bm2 = wzd.Item(s.toID)
mB.Element(row, 0) = (s.Observe - bm2.appH + bm1.appH) * 1000#
mP.Element(row, row) = uWeight0 / s.Distance
Next row
End Sub
Public Sub Adj(B As Matrix, L As Matrix, P As Matrix)
Dim BT As Matrix, w As Matrix, Nbb As Matrix, Nbb1 As Matrix, i As Integer
Set BT = B.transpose()
Set w = BT.multiply(P).multiply(L) '法方程W
Set Nbb = BT.multiply(P).multiply(B) '法方程N
Set Nbb1 = Nbb.invert() '法方程N的逆阵
Dim x As Matrix, v As Matrix
Set x = Nbb1.multiply(w) '高程改正数
Set v = B.multiply(x).subtract(L) '高差改正数
'精度评定
pvv = v.invert().multiply(P).multiply(v).Element(0, 0)
uWeight = Sqr(pvv / fDegree) '计算单位权
Dim LL As Matrix, bm As Benchmark, s As LevelSection
Set LL = B.multiply(Nbb1).multiply(BT)
For i = 0 To msNum - 1 'miNum为必要观测数
Set bm = wzd.Item(i + 1)
bm.adjH = bm.appH + x.Element(i, 0) / 1000#
bm.msError = uWeight * Sqr(Nbb1.Element(i, i))
Next i
tDistance = 0
For i = 0 To sNum - 1
Set s = sections(i)
s.CorrectedValue = v.Element(i, 0)
s.AdjustedObserve = s.Observe + s.CorrectedValue / 1000#
s.meanSquareError = uWeight * Sqr(LL.Element(i, i))
tDistance = tDistance + s.Distance
Next i
End Sub
Public Function outResult()
Dim s As String
Dim newline As String, i As Integer, bm As Variant
Dim j As Integer, ts As Variant
newline = Chr(13) + Chr(10)
s = String(90, "-") + newline
s = s + " APPROXIMATE HEIGHT" + newline '输出近似高程
s = s + String(90, "-") + newline
s = s + " No. Name Height(m) " + newline
s = s + String(90, "-") + newline
j = 0
For Each bm In qsd.Values ' '输出已知点
j = j + 1
s = s + Format(i, String(6, "@")) + Format(bm.id, String(17, "@"))
s = s + Format(Format(bm.appH, "0.0000"), String(12, "@")) + newline
Next
For Each bm In wzd.Values '输出未知点
j = j + 1
s = s + Format(j, String(6, "@")) + Format(bm.id, String(17, "@"))
s = s + Format(Format(bm.appH, "0.0000"), String(12, "@")) + newline
Next
s = s + String(90, "-") + newline '输出已知点高程
s = s + " KNOWN HEIGHT" + newline
s = s + String(90, "-") + newline
For i = 1 To qsd.Count '输出已知点
Set bm = qsd.Item(i)
s = s + Format(i, String(6, "@")) + Format(bm.id, String(17, "@"))
s = s + Format(Format(bm.appH, "0.0000"), String(12, "@")) + newline
Next i
s = s + String(90, "-") + newline '输出测段观测高差
s = s + " MEASURING DATA OF HEIGHT DIFFERENCE" + newline
s = s + String(90, "-") + newline
s = s + " NO. From TO "
s = s + "Observe(m) Distance(km) Weight" + newline
s = s + String(90, "-") + newline
For i = 0 To UBound(sections)
Set ts = sections(i)
s = s + Format(i + 1, String(6, "@")) + Format(ts.fromID, String(18, "@"))
s = s + Format(ts.toID, String(19, "@"))
s = s + Format(Format(ts.Observe, "0.0000"), String(14, "(@"))
s = s + Format(Format(ts.Distance, "0.00"), String(12, "(@"))
s = s + Format(Format(1# / ts.Distance, " 0.000000"), String(15, "(@"))
s = s + newline
Next i
s = s + String(90, "-") + newline '输出平差高程
s = s + " ADJUSTED HEIGHT" + newline
s = s + String(90, "-") + newline
s = s + "No Name Height(m) Mh(mm)" + newline
s = s + String(90, "-") + newline
j = 0
For Each bm In qsd.Values '输出已知点
j = j + 1
s = s + Format(j, String(6, "@")) + Format(bm.id, String(18, "@"))
s = s + Format(Format(bm.adjH, " 0.0000"), String(13, "@"))
s = s + Format(Format(bm.msError, "0.0000"), String(13, "@"))
s = s + newline
Next
For Each bm In wzd.Values '输出未知点
j = j + 1
s = s + Format(j, String(6, "(@")) + Format(bm.id, String(18, "(@"))
s = s + Format(Format(bm.adjH, " 0.0000"), String(13, "(@"))
s = s + Format(Format(bm.msError, " 0.0000"), String(13, "(@"))
s = s + newline
Next
s = s + String(90, "-") + newline
s = s + " ADJUSTED HEIGHT DIFFERENCE" + newline
s = s + String(90, "-") + newline
s = s + " No. From "
s = s + "To Adjusted_dh(m) V(mm) Mdh(mm) " + newline
s = s + String(90, "-") + newline
For i = 0 To UBound(sections)
Set ts = sections(i)
s = s + Format(i + 1, String(6, "@")) + Format(ts.fromID, String(21, "@"))
s = s + Format(ts.toID, String(19, "(@"))
s = s + Format(Format(ts.AdjustedObserve, " 0.0000"), String(20, "@"))
s = s + Format(Format(ts.CorrectedValue, "0.00"), String(10, "@"))
s = s + Format(Format(ts.meanSquareError, "0.00"), String(13, "@")) + newline
Next i
s = s + String(90, "-") + newline
s = s + " UNIT WEIGHT AND PVV " + newline
s = s + String(90, "-") + newline
s = s + " PVV= " + Format(pvv, "0.0000 ") + newline
s = s + " Free Degree=" + Format(fDegree, "####")

[舉杯邀明月]

代码不完整，你需要在工程中加入Dcollection和Levelsection这两个类模块的代码。