VB列选主元高斯消去法

列选主元高斯约化法：

Dim Row%, Col%, n% '矩阵大小

Dim iStep%, iRow%, iCol% '循环变量

Dim L() As Double '各行的约化系数

'计算并检查矩阵的大小

Row = UBound(a, 1) - LBound(a, 1) + 1

Col = UBound(a, 2) - LBound(a, 2) + 1

'准备约化过程的变量和数组

n = UBound(b) - LBound(b) + 1 ‘计算常数项矩阵大小ReDim L(2 To Row) As Double

Dim sumAX As Double, iPos%, temp#

'约化过程

For iStep = 1 To n – 1 '列选主元

For iRow = iStep + 1 To n

If Abs(a(iRow, iStep)) > Abs(a(iStep, iStep)) Then

iPos = iRow

End If

Next iRow

If iPos > iStep Then '需要换主元

For iCol = iStep To n

temp = a(iStep, iCol)

a(iStep, iCol) = a(iPos, iCol)

a(iPos, iCol) = temp

Next iCol

temp = b(iStep)

b(iStep) = b(iPos)

b(iPos) = temp

End If

For iRow = iStep + 1 To n '约化过程

L(iRow) = a(iRow, iStep) / a(iStep, iStep)

For iCol = iStep To n

a(iRow, iCol) = a(iRow, iCol) - L(iRow) * a(iStep, iCol) Next iCol

b(iRow) = b(iRow) - L(iRow) * b(iStep)

Next iRow

Next iStep

x(n) = b(n) / a(n, n) '回代过程

For iRow = n - 1 To 1 Step -1

sumAX = 0

For iCol = n To iRow + 1 Step -1

sumAX = sumAX + a(iRow, iCol) * x(iCol)

Next iCol

x(iRow) = (b(iRow) - sumAX) / a(iRow, iRow)

Next iRow

两点距离：

detX = x2 - x1: detY = y2 - y1

distAB = Sqr(detX ^ 2 + detY ^ 2)

度.分秒换成弧度：

du = Fix(DFM)

DFM= (DFM- du) * 100

fen = Fix(DFM)

miao = (DFM - fen) * 100

Angle = du + fen / 60 + miao / 3600

DoToHu = Angle * pi / 180

弧度换成度.分秒格式：

Hu = Hu * 180 / pi: du = Fix(Hu)

Hu = (Hu - du) * 60: fen = Fix(Hu)

Hu = (Hu - fen) * 60: miao = Fix(Hu + 0.5)

If miao = 60 Then

fen = fen + 1: miao = 0

End If

If fen = 60 Then

du = du + 1: fen = 0

End If

HuToDo = du + fen / 100 + miao / 10000

坐标方位角：

If Abs(dX) < 0.0000001 Then

If dY > 0 Then

DirectAB = pi / 2

Else

DirectAB = pi * 3 / 2

End If

Else

tana = dY / dX

DirectAB = Atn(tana)

If dX < 0 Then

DirectAB = pi + DirectAB

ElseIf dX > 0 And dY < 0 Then

DirectAB = pi * 2 + DirectAB

End If

End If

矩阵乘：

For i = 1 To R1

For j = 1 To C2

For k = 1 To C1

c(i, j) = c(i, j) + a(i, k) * b(k, j)

Next k

Next j

Next i

矩阵加减：

For i = 1 To R1

For j = 1 To C1

c(i, j) = a(i, j) ±b(i, j)

Next j

Next i

矩阵转置：

For i = 1 To R1

For j = 1 To C1

c(j, i) = a(i, j)

Next j

Next i

迭代法求方程的根：f(x) = x * x * x + x * x - 1 dif = 0.0001 `设置精度

a =0：

b = 1 `根所在区间

x1 = 1

Do While Abs(x - x1) > dif

x1 = x

x = (a + b) / 2

If f(a) * f(x) > 0 Then

a = x

Else

b = x

End If

n = n + 1

Loop