Bài mới

Wednesday, August 6, 2014

Một số function thông dụng for excel để Anh em có thể đưa vào các bài toán giải quyết cho kỹ thuật:


1/ Hàm tính hệ số tải trọng gây lún
Function Igt(a As Variant, b As Variant, x As Variant, Z As Variant) As Variant
Dim alpha, beta, rr As Variant
Dim angle1, angle2, angle3 As Variant
Dim pi As Double
pi = Application.WorksheetFunction.pi()
rr = (a + b - x) * (a + b - x) + Z * Z
angle1 = Math.Atn((a + b - x) / Z)
angle2 = Math.Atn((a - x) / Z)
angle3 = Math.Atn(x / Z)
alpha = angle3 + angle2
beta = angle1 - angle2
Igt = (beta + x * alpha / a - Z * (x - a - b) / rr / rr) / pi
End Function
2/ Dien giai cong thuc theo cac so nhap vao de tinh toan(giong nhu DU TOAN)
Public Function DiengiaiCT(rngData As Range)
Dim strText As String, strText2 As String
Dim i As Long, j As Long, Dem As Long
Dim subText() As String, dau() As String
Dim Res As Double
If rngData = "" Then Exit Function
strText = rngData.Formula
For i = 1 To Len(strText)
Select Case Mid(strText, i, 1)
Case "+", "-", "*", "/", "^"
ReDim Preserve dau(j)
dau(j) = Mid(strText, i, 1)
j = j + 1
End Select
Next i
strText = Replace(strText, "=", "")
strText = Replace(strText, "+", "@")
strText = Replace(strText, "-", "@")
strText = Replace(strText, "*", "@")
strText = Replace(strText, "/", "@")
strText = Replace(strText, "\", "@")
strText = Replace(strText, "^", "@")
strText = Trim(strText)
subText = Split(strText, "@")
For i = 0 To UBound(subText)
On Error Resume Next
If Not IsNumeric(subText(i)) Then
Err.Clear
Res = Application.WorksheetFunction.Find("(", subText(i))
If Err.Number = 0 Then
Dem = 0
For j = 1 To Len(subText(i))
If Mid(subText(i), j, 1) = "(" Then Dem = Dem + 1
Next j
subText(i) = Replace(subText(i), "(", "")
If IsNumeric(subText(i)) Then
subText(i) = String(Dem, "(") & subText(i)
Else
subText(i) = String(Dem, "(") & Range(subText(i)).Value
End If
End If
Err.Clear
Res = Application.WorksheetFunction.Find(")", subText(i))
If Err.Number = 0 Then
Dem = 0
For j = 1 To Len(subText(i))
If Mid(subText(i), j, 1) = ")" Then Dem = Dem + 1
Next j
subText(i) = Replace(subText(i), ")", "")
If IsNumeric(subText(i)) Then
subText(i) = subText(i) & String(Dem, ")")
Else
subText(i) = Range(subText(i)).Value & String(Dem, ")")
End If
End If
subText(i) = Range(subText(i)).Value
End If
Next i
ReDim Preserve dau(UBound(subText))
For i = 0 To UBound(subText)
strText2 = strText2 & subText(i) & dau(i)
Next i
DiengiaiCT = strText2
End Function
3/'Ham noi suy mot chieu
Public Function noisuy1(vungtra As Range, x As Double, cot As Integer) As Double
'ham noi suy 1 chieu
Dim ktra As Boolean
Dim i As Integer
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
For i = 1 To vungtra.Cells.Count
kiemtra = False
If vungtra.Cells(i, 1) <= x And vungtra.Cells(i + 1, 1) >= x Then
x1 = vungtra.Cells(i, 1): x2 = vungtra.Cells(i + 1, 1)
y1 = vungtra.Cells(i, cot): y2 = vungtra.Cells(i + 1, cot)
noisuy1 = (y2 - y1) * (x - x1) / (x2 - x1) + y1
ktra = True
End If
Next i
If ktra = False Then
'MsgBox "gia tri can tim ko nam trong bang tra", vbInformation
Exit Function
End If
End Function
'Noi suy hai chieu
Function noisuy2(vungtra As Range, x As Double, Y As Double) As Double
4/ 'ham noi suy 2 chieu
Dim ktra As Boolean
Dim i As Integer, j As Integer
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim a11 As Double, a12 As Double, a21 As Double, a22 As Double
Dim t1 As Double, t2 As Double
For j = 2 To vungtra.Cells.Count
If vungtra.Cells(1, j) <= Y And vungtra.Cells(1, j + 1) >= Y Then
For i = 2 To vungtra.Cells.Count
ktra = False
If vungtra.Cells(i, 1) <= x And vungtra.Cells(i + 1, 1) >= x Then
x1 = vungtra.Cells(i, 1): x2 = vungtra.Cells(i + 1, 1)
y1 = vungtra.Cells(1, j): y2 = vungtra.Cells(1, j + 1)
a11 = vungtra.Cells(i, j): a12 = vungtra.Cells(i, j + 1)
a21 = vungtra.Cells(i + 1, j): a22 = vungtra.Cells(i + 1, j + 1)
t1 = (a12 - a11) * (Y - y1) / (y2 - y1) + a11
t2 = (a22 - a21) * (Y - y1) / (y2 - y1) + a21
noisuy2 = (t2 - t1) * (x - x1) / (x2 - x1) + t1
End If
Next i
ktra = True
End If
Next j
If ktra = False Then
MsgBox "gia tri can tim ko nam trong bang tra", vbInformation
Exit Function
End If
End Function
Note: Sưu tầm từ giaiphapexcel.com

Bấm Youtube để đăng ký xem video nhé!

Bài viết liên quan:



No comments:

Post a Comment

Designed By