Ðề: Mỗi tuần một hàm trong Excel!

Tôi cũng xin post một hàm dùng để tính dầm CN chịu M, Q và M-xoắn

Public Sub Uphang_xoan_cnhat(M As Single, Q As Single, MX As Single, b As Single, h As Single, a As Single, Fk As Single, Fn As Single, Fk1 As Single, Fn1 As Single, Ra As Single, Rad As Single, Rn As Single, Rk As Single, anfa0 As Single, fd As Single, u As Single, u_min As Single, ktraDam As Boolean)
'Thu tuc tinh Fk, Fn, Fk1, Fn1 de chong xoan (voi fd va u chon truoc)
Dim h0 As Single, b0 As Single, delta_Fk As Single, kq As Boolean
Dim C(1 To 100) As Single, MM As Single, MM_min As Single, tam As Single
Dim m0 As Single, m_d As Single, v As Single, qd As Single, Qdb As Single
Dim Fk_max As Single, Fk_min As Single, Fk1_max As Single, Fk1_min As Single
Dim x As Single, i As Long
'**************************************************************
'Kiem tra dk han che cua Mx:
If MX > (0.1 * Rn * h * b ^ 2) Then
ktraDam = False 'Mx qua lon, khong thoa dk han che.
Exit Sub 'Khong the tke dam voi kich thuoc da chon
End If
'Neu thoa man dk han che, ta kiem tra cac gia tri tai trong
If MX = 0 Then MX = 1 'de tranh loi chia cho 0
If MX < 0 Then MX = -MX 'Chi tinh toan voi cac gia tri duong
If Q < 0 Then Q = -Q 'Chi tinh toan voi cac gia tri duong
If Q = 0 Then Q = 1 'de tranh loi chia cho 0
If M < 0 Then M = -M 'Chi tinh toan voi cac gia tri duong
v = M / MX
If v >= 10 Then v = 10 'can thiet de dam bao mo khong qua nho
'neu khong ctrinh se lam tang Fk de thoa dk m_d<3*m0
u = mdl01.min2so(u_min, h / 3)
'Ngay tu dau, chon luon u nho nhat de chong xoan.
If Fk < 1.57 * 0.0001 Then Fk = 1.57 * 0.0001 'Toi thieu 2fi10
If Fn < 1.57 * 0.0001 Then Fn = 1.57 * 0.0001 'Toi thieu 2fi10
If Fk1 < 1.57 * 0.0001 Then Fk1 = 1.57 * 0.0001 'Toi thieu 2fi10
If Fn1 < 1.57 * 0.0001 Then Fn1 = 1.57 * 0.0001 'Toi thieu 2fi10
delta_Fk = 0.1: h0 = h - a: b0 = b - a
'**************************************************************
'TINH TOAN KIEM TRA THEO M VA MX:
m0 = 1 / ((2 + 4 * v * Sqr(b / (2 * h + b))) * (2 * h + b) * b)
Fk_min = (Rad * fd) / (3 * Ra * (2 * h + b) * u * m0) ':Fk_max = 3 * Fk_min
If Fk < Fk_min Then Fk = Fk_min
kq = False
Do
x = (Ra * (Fk - Fn)) / (Rn * b)
If x > anfa0 * h0 Then 'Qua nhieu thep, dam bi nut
Fk = -1: Fn = -1: ktraDam = False: Exit Sub
End If
m_d = Rad * fd / (Ra * Fk * (2 * h + b) * u)
'Tinh MM_min (Kha nang chong xoan nho nhat):
C(1) = (2 * h + b) / 100
MM_min = (Ra * Fk * (h0 - 0.5 * x) * (1 + m_d * C(1) * C(1)) * b) / (C(1) + v * b)
For i = 2 To 100
C(i) = i * C(1)
tam = (Ra * Fk * (h0 - 0.5 * x) * (1 + m_d * C(i) * C(i)) * b) / (C(i) + v * b)
If MM_min >= tam Then MM_min = tam
Next
If MX <= 0.95 * MM_min Then
kq = True
Else
If Fk < (0.02 * b * h0) Then
Fk = Fk + delta_Fk
Else 'Khong the tke dam voi kich thuoc, fd, u da chon
ktraDam = False
Fk = -1: Fn = -1
Exit Sub
End If
End If
Loop Until kq = True
'**************************************************************
'TINH TOAN KIEM TRA THEO MX VA Q:
'Kiem tra dk:
If MX <= 0.5 * Q * b Then
qd = Rad * fd / u 'Voi u=u_min
Qdb = Sqr(8 * Rk * b * h0 * h0 * qd)
If (Q + 3 * MX / h) <= Qdb Then
Exit Sub 'Khong can kiem tra tiep nua.
End If
End If
'm0 = 1 / ((2 + 4 * v * Sqr(h / (2 * b + h))) * (2 * b + h) * h)
'Fk1_min = (Rad * fd) / (3 * Ra * (2 * b + h) * u * m0) ':Fk1_max = 3 * Fk1_min
'If Fk1 < Fk1_min Then Fk1 = Fk1_min '(Khong can dung cac lenh nay)
kq = False
Do
x = (Ra * (Fk1 - Fn1)) / (Rn * h)
If x > anfa0 * h0 Then 'Qua nhieu thep, dam bi nut
Fk = -1: Fn = -1: ktraDam = False: Exit Sub
End If
m_d = (Rad * fd) / (Ra * Fk1 * (2 * b + h) * u)
'Tinh MM_min (Kha nang chong xoan nho nhat):
C(1) = (2 * b + h) / 100
MM_min = (Ra * Fk1 * (b0 - 0.5 * x) * (1 + m_d * C(1) ^ 2) * h) / (C(1) * (1 + Q * b / (2 * MX)))
For i = 2 To 100
C(i) = i * C(1)
tam = (Ra * Fk1 * (b0 - 0.5 * x) * (1 + m_d * C(i) ^ 2) * h) / (C(i) * (1 + Q * b / (2 * MX)))
If MM_min >= tam Then MM_min = tam
Next
If MX <= 0.95 * MM_min Then
kq = True
Else
If Fk1 < (0.01 * b0 * h) Then
Fk1 = Fk1 + delta_Fk
Else 'Khong the tke dam voi kich thuoc, fd, u da chon
ktraDam = False
Fk1 = -1: Fn1 = -1
Exit Sub
End If
End If
Loop Until kq = True
'Ket qua ta duoc Fk, Fn, Fk1, Fn1, u=u_min, fd
End Sub

Ðề: Mỗi tuần một hàm trong Excel!

Bạn muốn nối suy dữ liệu chứa trong file CSDL ACCESS phải không. Theo tôi, giả sử dữ liệu của bạn chứa trong một bảng (hay nhiều bảng) của một cơ sở dữ liệu.MDB.
Trước tiên, bạn dùng một câu lệnh SQL để gom các dữ liệu cần truy cứu vào một dối tượng DAO.Recordset (mở ở dạng DBOpendynaset).
- Dùng các phương thức tìm kiểm của đối tượng Recordset như MoveFirst, MoveNext.. để định vị con trỏ đọc mẫu tin ở record cần tìm.
- Dùng các phương thức Movenext, MovePrevious.. để đọc các giá trị "xung quanh" giá trị cần nội suy và lưu vào các biến (vd: X_tr, X_d, Y_tr, Y_d)
- Dùng công thức nội suy để xác định giá trị cần tìm.

Ðề: Mỗi tuần một hàm trong Excel!

nhân có các hàm "Ễch xeo" em hỏi các bác 1 câu hơi thô thiển tý là tính căn bậc ba thế nào ạ? hic

Ðề: Mỗi tuần một hàm trong Excel!

goi Nhaiben
Private Function Can_bac_n(Byval x as Single, byval n as long) as single
Can_bac_n=x^(1/n)
End function

Sau do goi ham bang cách:
y=(12032,3)

Ðề: Mỗi tuần một hàm trong Excel!

goi Nhaiben
Public Function Can_bac_n(Byval x as Single, byval n as long) as single
Can_bac_n=x^(1/n)
End function

Sau do goi ham bang cách:
y=(12032,3)

Ðề: Mỗi tuần một hàm trong Excel!

goi Nhaiben

Public Function Can_bac_n(Byval x as Single, byval n as long) as single
Can_bac_n=x^(1/n)
End function

Sau do goi ham bang cách:
y=Can_bac_n(12032,3)

Ðề: Mỗi tuần một hàm trong Excel!

chào bác PMXD
Ham tra bang cua bac co tra ve k=0,khi gia tri m=gia tri trong bang tra,con a/b khac gia tri trongbang tra
chao than ai

Ðề: Mỗi tuần một hàm trong Excel!

Thấy vấn đề tra bảng trong EXCEL sôi nổi quá, tôi cũng gởi một hàm lên để các bạn tham khảo cho vui.

-----

Public Function Tra_Bang(gtri_h_tim As Single, gtri_c_tim As Single, Vung_data As Excel.Range) As Single
'Trong do:
'Vung_data la toan bo vung bang chua du lieu, ke ca vung chua tieu de cua hang va cot
'Gtri_h_tim la gia tri de xac dinh chi so cua Hang can tim,
'Khi Vung_data chi co mot Cot, tuc la : n_c=1 thi phai nhap gtri_h_tim=1
'Gtri_c_tim la gia tri de xac dinh chi so cua Cot can tim
'Khi Vung_data chi co mot hang, tuc la : n_h=1 thi phai nhap gtri_c_tim=1
Dim Bang_2C() As Single 'La mang chua cac du lieu cua bang
Dim n_h As Integer, n_c As Integer 'So hang va cot cua bang du lieu
Dim gtri_h() As Single 'La mang 1 chieu chua gia tri cua tieu de hang cua bang du lieu
Dim gtri_c() As Single 'La mang 1 chieu chua gia tri cua tieu de cot cua bang du lieu
Dim cso_h1 As Integer, cso_h2 As Integer, cso_c1 As Integer, cso_c2 As Integer
Dim X_h1c1 As Single, X_h1c2 As Single, X_h2c1 As Single, X_h2c2 As Single
Dim X_H1 As Single, X_H2 As Single, X_tim As Single
Dim Delta_cot As Single, Delta_hang As Single
Dim i As Integer, j As Integer
'=========================================================================
'DOC DU LIEU VAO BANG
Vung_data.Select

n_c = Selection.Columns.Count - 1
n_h = Selection.Rows.Count - 1
Selection.Cells(1).Activate 'Chon o dau tien cua bang lam hien hanh
ReDim Bang_2C(1 To n_h, 1 To n_c)
ReDim gtri_h(1 To n_h)
ReDim gtri_c(1 To n_c)
For i = 1 To n_c
gtri_c(i) = ActiveCell.Offset(0, i).Value
Next
For i = 1 To n_h
gtri_h(i) = ActiveCell.Offset(i, 0).Value
Next
For i = 1 To n_h
For j = 1 To n_c
Bang_2C(i, j) = ActiveCell.Offset(i, j).Value
Next
Next
'BAT DAU NOI SUY
'Xac dinh chi so hang tren va duoi so voi gtri_h_tim
If n_h > 1 Then
For i = 1 To (n_h - 1)
If (gtri_h(i) <= gtri_h_tim And gtri_h(i + 1) >= gtri_h_tim) Or (gtri_h(i) >= gtri_h_tim And gtri_h(i + 1) <= gtri_h_tim) Then
cso_h1 = i
cso_h2 = i + 1
Delta_hang = gtri_h(i + 1) - gtri_h(i)
Exit For
End If
Next
ElseIf n_h = 1 Then 'Bang du lieu chi gom mot hang chua du lieu
cso_h1 = 1: cso_h2 = 1
Delta_hang = 1
Else
MsgBox "Du lieu khong hop ly"
GoTo thoat
End If
'Xac dinh chi so cot ben trai va ben phai so voi gtri_c_tim
If n_c > 1 Then
For i = 1 To (n_c - 1)
If (gtri_c(i) <= gtri_c_tim And gtri_c(i + 1) >= gtri_c_tim) Or (gtri_c(i) >= gtri_c_tim And gtri_c(i + 1) <= gtri_c_tim) Then
cso_c1 = i
cso_c2 = i + 1
Delta_cot = gtri_c(i + 1) - gtri_c(i)
Exit For
End If
Next
ElseIf n_c = 1 Then 'Bang du lieu chi gom Cot hang chua du lieu
cso_c1 = 1: cso_c2 = 1: Delta_cot = 1
Else
MsgBox "Du lieu khong hop ly"
GoTo thoat
End If
'Dua gia tri trong bang tra vao cac bien tam
X_h1c1 = Bang_2C(cso_h1, cso_c1)
X_h1c2 = Bang_2C(cso_h1, cso_c2)
X_h2c1 = Bang_2C(cso_h2, cso_c1)
X_h2c2 = Bang_2C(cso_h2, cso_c2)
'Bat dau noi suy dot 1:
X_H1 = X_h1c1 + (X_h1c2 - X_h1c1) * (gtri_c_tim - gtri_c(cso_c1)) / Delta_cot
X_H2 = X_h2c1 + (X_h2c2 - X_h2c1) * (gtri_c_tim - gtri_c(cso_c1)) / Delta_cot
'Noi suy dot 2
X_tim = X_H1 + (X_H2 - X_H1) * (gtri_h_tim - gtri_h(cso_h1)) / Delta_hang

'=========================================================================
ReDim Bang_2C(0): ReDim gtri_h(0): ReDim gtri_c(0)
'Ghi ket qua noi suy:
Tra_Bang = X_tim
thoat:
End Function

Ðề: Mỗi tuần một hàm trong Excel!

Các hàm này tôi đã post trong hàm tính toán Fadam, bạn xem lại nhé

Ðề: Mỗi tuần một hàm trong Excel!

Xin lỗi anh PMXD vì chưa đọc kỹ các hàm anh viết.
Trong phân tích động lực học công trình, vấn đề xác định các tần số dao động riêng là vấn đề cần thiết. và đây cũng là vấn đề rất nan giải về thuật toán và lập trình. để các bạn đang nghiên cứu về động lực học công trình tham khảo, tôi xin gởi các bạn hàm tính tần số dao động riêng của công trình. hàm này tôi đã mất 1 tháng để viết đó.
'DOAN CHUONG TRINH TINH TOAN CAC GIA TRI RIENG CUA MTRAN
'HOAN THANH NGAY 05/03/2003. Trong ham nay khong xet den phan ao cua cac gia tri rieng
Private Sub Balanc(A() As Double, ByVal n As Integer)
Const RADIX = 2
Dim last As Integer, i As Integer, j As Integer
Dim s As Double, r As Double, g As Double
Dim f As Double, c As Double, sqrdx As Double
DoEvents: If mdl01.tiep_tuc = False Then Exit Sub
frmSTATUS.lblstatus01(1).Caption = mdl01.StrTbao & Chr(10) & "(Transform to Balanc matric)"
frmSTATUS.ProgressBar1.max = n
frmSTATUS.ProgressBar1.Value = 0
frmSTATUS.lblstatus01(1).Refresh
sqrdx = RADIX * RADIX
last = 0
While last = 0
frmSTATUS.ProgressBar1.Value = frmSTATUS.ProgressBar1.Value + 1
last = 1
For i = 1 To n
r = 0
c = 0
For j = 1 To n
If Not (i = j) Then
c = c + Abs(A(j, i))
r = r + Abs(A(i, j))
End If
Next
If (c And r) Then
g = r / RADIX
f = 1
s = c + r
Do While c < g
f = f * RADIX
c = c * sqrdx
Loop
g = r * RADIX
While c > g
f = f / RADIX
c = c / sqrdx
Wend
If ((c + r) / f < 0.95 * s) Then
last = 0
g = 1 / f
For j = 1 To n
A(i, j) = A(i, j) * g
Next
For j = 1 To n
A(j, i) = A(j, i) * f
Next
End If
End If
Next
Wend
frmSTATUS.ProgressBar1.Value = frmSTATUS.ProgressBar1.max
End Sub

Private Sub Hessenberg(A() As Double, ByVal n As Integer)
Dim m As Integer, i As Integer, j As Integer
Dim x As Double, y As Double, tg As Double
frmSTATUS.lblstatus01(1).Caption = mdl01.StrTbao & Chr(10) & "(Transforming to Hessenberg matric form)"
frmSTATUS.ProgressBar1.max = n - 3
frmSTATUS.ProgressBar1.Value = 0
frmSTATUS.lblstatus01(1).Refresh
For m = 2 To n - 1
DoEvents
If mdl01.tiep_tuc = False Then Exit Sub
x = 0
i = m
For j = m To n
If Abs(A(j, m - 1)) > Abs(x) Then
x = A(j, m - 1)
i = j
End If
Next
If Not (i = m) Then
For j = m - 1 To n
tg = A(i, j)
A(i, j) = A(m, j)
A(m, j) = tg
Next
For j = 1 To n
tg = A(j, i)
A(j, i) = A(j, m)
A(j, m) = tg
Next
End If
If Not (x = 0) Then
For i = m + 1 To n
y = A(i, m - 1) / x
For j = m To n
A(i, j) = A(i, j) - y * A(m, j)
Next
For j = 1 To n
A(j, m) = A(j, m) + y * A(j, i)
Next
Next
End If
frmSTATUS.ProgressBar1.Value = m - 2
Next
End Sub

Private Function Sign(ByVal A As Double, ByVal B As Double) As Double
If B > 0 Then
Sign = Abs(A)
Else
Sign = -Abs(A)
End If
End Function

Public Function Eig(A() As Double, ByVal n As Integer) As Double()
Dim nn As Integer, m As Integer, l As Integer
Dim k As Integer, j As Integer, its As Integer
Dim i As Integer, mmin As Integer, status As Integer
Dim z As Double, y As Double, x As Double
Dim w As Double, v As Double, u As Double
Dim t As Double, s As Double, r As Double
Dim p As Double, q As Double, anorm As Double
Dim wr() As Double
'========================================
Balanc A, n
Hessenberg A, n
'========================================
'BAT DAU TINH CAC GIA TRI RIENG:
'========================================
ReDim wr(1 To n) As Double
frmSTATUS.lblstatus01(1).Caption = mdl01.StrTbao & Chr(10) & "(Computing EigValues)"
frmSTATUS.ProgressBar1.max = n
frmSTATUS.ProgressBar1.Value = 0
frmSTATUS.lblstatus01(1).Refresh
anorm = Abs(A(1, 1))
For i = 2 To n
For j = (i - 1) To n
anorm = anorm + Abs(A(i, j))
Next
Next
status = 0
nn = n
t = 0
While nn >= 1
DoEvents
If mdl01.tiep_tuc = False Then Exit Function
its = 0
Do
For l = nn To 2 Step -1
s = Abs(A(l - 1, l - 1)) + Abs(A(l, l))
If s = 0 Then s = anorm
If Abs(A(l, l - 1)) + s = s Then Exit For
Next
x = A(nn, nn)
If l = nn Then
wr(nn) = x + t
nn = nn - 1
status = status + 1
frmSTATUS.ProgressBar1.Value = status
Else
y = A(nn - 1, nn - 1)
w = A(nn, nn - 1) * A(nn - 1, nn)
If l = (nn - 1) Then
p = 0.5 * (y - x)
q = p * p + w
z = Sqr(Abs(q))
x = x + t
If q >= 0 Then
z = p + Sign(z, p)
wr(nn - 1) = x + z
wr(nn) = x + z
If Not (z = 0) Then wr(nn) = x - w / z
Else
wr(nn - 1) = x + p
wr(nn) = x + p
End If
nn = nn - 2
status = status + 2
frmSTATUS.ProgressBar1.Value = status
Else
If (its = 10) Or (its = 20) Then
t = t + x
For i = 1 To nn
A(i, i) = A(i, i) - x
Next
s = Abs(A(nn, nn - 1)) + Abs(A(nn - 1, nn - 2))
y = 0.75 * s
x = 0.75 * s
w = -0.4375 * s * s
End If
its = its + 1
For m = (nn - 2) To l Step -1
z = A(m, m)
r = x - z
s = y - z
p = (r * s - w) / A(m + 1, m) + A(m, m + 1)
q = A(m + 1, m + 1) - z - r - s
r = A(m + 2, m + 1)
s = Abs(p) + Abs(q) + Abs(r)
p = p / s
q = q / s
r = r / s
If m = l Then Exit For
u = Abs(A(m, m - 1)) * (Abs(q) + Abs(r))
v = Abs(p) * (Abs(A(m - 1, m - 1)) + Abs(z) + Abs(A(m + 1, m + 1)))
If u + v = v Then Exit For
Next
For i = m + 2 To nn
A(i, i - 2) = 0
If Not (i = (m + 2)) Then A(i, i - 3) = 0
Next
For k = m To nn - 1
If Not (k = m) Then
p = A(k, k - 1)
q = A(k + 1, k - 1)
r = 0
If Not (k = (nn - 1)) Then r = A(k + 2, k - 1)
x = Abs(p) + Abs(q) + Abs(r)
If Not (x = 0) Then
p = p / x
q = q / x
r = r / x
End If
End If
s = Sign(Sqr(p * p + q * q + r * r), p)
If Not (s = 0) Then
If k = m Then
If Not (l = m) Then
A(k, k - 1) = -A(k, k - 1)
End If
Else
A(k, k - 1) = -s * x
End If
p = p + s
x = p / s
y = q / s
z = r / s
q = q / p
r = r / p
For j = k To nn
p = A(k, j) + q * A(k + 1, j)
If Not (k = (nn - 1)) Then
p = p + r * A(k + 2, j)
A(k + 2, j) = A(k + 2, j) - p * z
End If
A(k + 1, j) = A(k + 1, j) - p * y
A(k, j) = A(k, j) - p * x
Next
If nn < k + 3 Then
mmin = nn
Else
mmin = k + 3
End If
For i = l To mmin
p = x * A(i, k) + y * A(i, k + 1)
If Not (k = (nn - 1)) Then
p = p + z * A(i, k + 2)
A(i, k + 2) = A(i, k + 2) - p * r
End If
A(i, k + 1) = A(i, k + 1) - p * q
A(i, k) = A(i, k) - p
Next
End If
Next
End If
End If
Loop While l < (nn - 1)
Wend
Eig = wr
End Function

Ðề: Mỗi tuần một hàm trong Excel!

Tôi rất muốn nghiên cứu về VBA, thực tế cũng đã hiểu cơ bản, nhưng tài liệu về VBA rất ít (tiếng Việt), các đồng nghiệp giúp tôi với, cảm ơn trước.

Ðề: Mỗi tuần một hàm trong Excel!

Để nghiên cứu về VBA (for Excel) bạn nên:
- Mua quyển "Giải pháp VB 4 cho người lập trình chuyên nghiệp" và "VB6 & Lập trình cơ sở dử liệu" để đọc hiểu được ngôn ngữ Visual Basic.
- Mở Excel và dùng bộ thu Macro để thu lại các thao tác của bạn, Excel lập tức chuyển các thao tác trong các ổ của bảng tính thành ngôn ngữ Visual Basic, bạn sẽ học được cách truy xuất các đối tượng của bảng tính (đối tượng Range, Cell,..)
- Dùng công cụ Object Browser để tìm hiểu thêm các đối tượng, phương thức, thuộc tinh.. của Excel.
(Có thể bạn tìm quyển sách "Visual Basic for Excel 5.0", đã cũ rồi)
Chúc bạn sớm làm chủ được công cụ VBA (for Excel)

Ðề: Mỗi tuần một hàm trong Excel!

Cảm ơn bạn Le Viet Thanh, sao bạn có PP học VBA giống tôi vậy, kể cả quyển sách Visual Basic for Excel 5.0 cũng vậy, tôi đã mua nó lâu lắm rồi, nhưng chưa thỏa chí bạn à. Thân.

Ðề: Mỗi tuần một hàm trong Excel!

các anh có thể cho em cụ thể địa chỉ để mua sách này được không.em đang bí tài liệu quá.cám ơn nhiều.

Ðề: Mỗi tuần một hàm trong Excel!

Tôi nghĩ sách đó chỉ còn trong hiệu sác cũ, sách nhỏ thôi khoẳng trăm trang gì đó, bìa trắng, bạn xdbien chịu khó tìm vậy, chúc may mắn.