Nguyên văn bởi PMXD
View Post
QUẢNG CÁO ĐẦU TRANG
Collapse
Thông báo
Collapse
No announcement yet.
Mỗi tuần một hàm trong Excel!
Collapse
X
-
Ðề: Mỗi tuần một hàm trong Excel!
-
Ðề: 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 "
Chào anh LÊ VIỆT THANH!
Em thấy anh viết hay quá, đọc qua em hiểu sơ sơ,hihi.
Nhưng em add vào exel nó không chạy, anh chỉ giúp e được không ah?Last edited by tamkt; 28-08-2010, 06:39 PM.
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Nguyên văn bởi PMXD View PostChào các anh em trong diễn đàn!
Từ ngày hôm nay, tôi sẽ cố gắng post mỗi tuần một hàm Excel mà tôi đã từng dùng để tính toán thiết kế. Ai ủng hộ tôi xin hãy lên tiếng cho diễn đàn them khí thế!
'==================HÀM SỐ 1===========================
' NỘI SUY MỘT BẢNG THEO GIÁ TRỊ
'====================================================
Function TraBang2Chieu(ByVal Hang, ByVal Cot, VungChon As Range)
Dim i As Long, j As Long
Dim TangAnPha
Dim NoiSuy1 As Double, NoiSuy2 As Double
For i = 1 To UBound(VungChon.Value, 2) ' Theo phuong ngang
If Hang = VungChon(1, i) Then
For j = 1 To UBound(VungChon.Value, 1) - 1
If (Cot - VungChon(j, 1)) * (Cot - VungChon(j + 1, 1)) <= 0 Then
TangAnPha = (VungChon(j + 1, i) - VungChon(j, i)) / (VungChon(j + 1, 1) - VungChon(j, 1))
TraBang2Chieu = VungChon(j, i) + (Cot - VungChon(j, 1)) * TangAnPha
GoTo Thoat:
End If
Next j
ElseIf (Hang - VungChon(1, i)) * (Hang - VungChon(1, i + 1)) < 0 Then
For j = 1 To UBound(VungChon.Value, 1) - 1
If (Cot - VungChon(j, 1)) * (Cot - VungChon(j + 1, 1)) < 0 Then
TangAnPha = (VungChon(j, i + 1) - VungChon(j, i)) / (VungChon(1, i + 1) - VungChon(1, i))
NoiSuy1 = VungChon(j, i) + (Hang - VungChon(1, i)) * TangAnPha
TangAnPha = (VungChon(j + 1, i + 1) - VungChon(j + 1, i)) / (VungChon(1, i + 1) - VungChon(1, i))
NoiSuy2 = VungChon(j + 1, i) + (Hang - VungChon(1, i)) * TangAnPha
TangAnPha = (NoiSuy2 - NoiSuy1) / (VungChon(j + 1, 1) - VungChon(j, 1))
TraBang2Chieu = NoiSuy1 + (Cot - VungChon(j, 1)) * TangAnPha
GoTo Thoat:
End If
Next j
End If
Next i
Thoat:
'TraBang = UBound(VungChon.Value, 2)
End Function
'=====================================================
Mời các bác Copy hàm này vào Excel và sử dụng theo từng bước như sau:
1- Mở Excel
2- Nhấn Ctrl+F11
3- Insert 1 Module trong môi trường VBA
4- Copy hàm bên trên vào
5- Sử dụng như 1 hàm Excel thông thường với 3 tham số:
+ Giá trị của hàng
+ Giá trị của cột
+ Vùng giá trị của bảng
Ghi chú: Bác nào vẫn còn lơ mơ thì cứ A lô nhé
'===============================
Nguyễn Việt Anh
Phòng KCXD- IBST
047544277
2- Nhấn Ctrl+F11 phải là
2- Nhấn Alt+F11
Bro làm ơn chỉ dùm mình cách đưa qua file khác mà vẫn xài được sao mình qua file khác copy vào mà ko chạy. hic hic
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Bac nay len mang ma tim nhieu chuong trinh lam bac oi! Neu khong tim duoc thi gui day minh tim ho cho.
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Nguyên văn bởi luan2005Tô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.
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Nguyên văn bởi PMXDNhững VBA của tôi khó dùng lắm sao
Tôi mở chủ đề này để thảo luận về lập trình trong Excel mà. Có thể một số bạn cho rằng các hàm tôi đã Upload lên có thể viết lại bằng các hàm huẩn của Excel, điều đó cũng đúng thôi. Đã có câu nói là "Mọi con đường đều dẫn đến thành Rome mà". Tuy nhiên, nếu có khi nào mà các bạn ko thể dùng hàm chuẩn của Excel đã lập ứng dụng của các bạn thì gọi tôi nhé
Các chương trình viết bằng VBA khi quét Virus bằng công cụ của anh Nguyễn Tử Quảng thường bị clean luôn. Cái đó muốn khắc phục, các bạn cứ Zip nó lại là ngon lành ngay à. Các chương trình Scan Virus mới hiện nay đều đã tránh được tình trạng này rồi.
Chúc các bạn một năm mới an khang tịnh vượng, chúc diễn đàn sang năm mới có nhiều phát triển.
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Cục Modules nằm bên tay trái đó. add thêm vào ...........
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Mời các bác Copy hàm này vào Excel và sử dụng theo từng bước như sau:
1- Mở Excel
2- Nhấn Ctrl+F11
3- Insert 1 Module trong môi trường VBA
4- Copy hàm bên trên vào
5- Sử dụng như 1 hàm Excel thông thường với 3 tham số:
+ Giá trị của hàng
+ Giá trị của cột
+ Vùng giá trị của bảng
------------------------------------------------------------
anh ơi,anh nói cụ thể hơn 1 chút được ko?em vẫn chưa hiểu Insert 1 Module vào môi trường VBA là làm như thế nào?thanks
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Đúng là link này ko có gì hết trơn a bác ơi.
Bác có thể post lại được ko?
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Nguyên văn bởi DTH_HNTôi có phần mềm bẻ khóa trong excel load trên diễn đàn này về (không nhớ ở đâu nưa) thấy chạy tốt, gửi thử bằng mail rồi nhưng toàn báo không gửi được, đành up lên theo cái linh này
http://v-art.com.vn/vbapass.zip
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Nguyên văn bởi DTH_HNMình có bộ sách hướng dẫn VBA Excel, thấy khá hay, có rất nhiều hàm ví dụ theo sách.Post lên dây mọi người thử xem
Có thể load theo đường dẫn
http://www.v-art.com.vn/vba.zip
Leave a comment:
-
Ðề: Tiếp tục post bài
1- Tên hàm: Facot
2- Các tham số chính
M- Mô men (Kgm)
N- Lực dọc (Kg)
b- Bề rộng tiết diện (m)
h- Chiều cao tiết diện (m)
ao- Chiều dày lớp bảo vệ cốt thép
l - Chiều dài (thực tế) cột
Mdh- Thành phần momen dài hạn
Ndh- Thành phần lực dọc dài hạn
MBT- Mác bê tông (nếu ko nhập thì giá trị mặc định là 250)
KieuCotThep- Loại cốt thép (nếu ko nhập thì giá trị mặc định là "AII")
Kieulienket- Hình thức liên kết cua cột
= 1 : hai đầu ngàm
= 2 : hai đầu khớp
= 3 : 1 đầu ngàm, một đầu khớp
= 4 : 1 đầu ngàm, 1 đầu tự do
3- Thuật toán tổng thể của hàm
- Tính toán các thông số ban đầu
- Giả thiết giá trị hàm lượng cốt thép (Muy) ban đầu
- Tính toán giá trị Muy thực tế
- So sánh, tính lặp cho đến khi Muy giả thiết xấp xỉ Muy tính toán
- Tính diện tích cốt thép theo giá trị Muy cuối cùng
- So sánh với diện tích thép tính theo bài toán kéo (nén) đúng tâm
- Lấy giá trị Max của hai trường hợp
4- Nội dung của hàm
Function FaCot(ByVal M As Double, ByVal N As Double, ByVal b As Double, h As Double, _
ByVal ao As Double, ByVal l As Double, Optional Mdh = 0, Optional Ndh = 0, Optional MBT = 250, Optional KieuCotThep = "AII", Optional KieuLienKet = 1)
'============================Don vi tinh toan Kg,m
Dim Lo As Double 'Chieu dai tinh toan cua cau kien(m)
Dim ho As Double
Dim Muy As Double, nuy As Double, MuyGt As Double, NuyMin As Double
Dim Eo As Double, e As Double, eogh As Double, X As Double
Dim s As Double, Nth As Double
Dim Ja As Double, Jb As Double
Dim Phi As Double
Dim Kdh As Double
Dim MuyMin As Double
Dim Rn As Double, Rk As Double, Eb As Double, Ra As Double, Rad As Double, Ea As Double
Dim Fat As Double, HamLuongCot As Double
Dim Fadungtam As Double
If M <> 0 Then Kdh = 1 + Mdh / M
'==============================Xac dinh chieu dai tinh toan cua cot
Select Case KieuLienKet
Case 1 ' Hai dau ngam
Lo = 0.7 * l
Case 2 ' Hai dau khop
Case 3 'Dau ngam dau khop
Case 4 ' Dau ngam va Dau tu do
End Select
'==============================Xac dinh cac thong so cua be tong va thep
BeTong MBT, Rn, Rk, Eb
CotThep KieuCotThep, Ra, Rad, Ea
ho = h - ao
Phi = PhiUD(Lo, b, "R")
FaCot = 0: Fat = 0
'======================
MuyMin =TimMax(Array(HamLuongCot * 100, MuyMinVa(Lo, b, h, 0)))
If N = 0 Then
FaCot = 0: Fat = 0
ElseIf M = 0 And N < 0 Then
'================================Tinh toan cau kien chiu nen trung tam tiet dien chu nhat
N = Abs(N)
FaCot = ((N / Phi - Rn * b * h)) / Ra
Fat = ((N / Phi - Rn * b * h)) / Ra
Muy = 100 * (FaCot + Fat) / (b * ho)
'==========================================================================
ElseIf M <> 0 And N < 0 Then
'==================================Tinh toan cau kien chiu nen lech tam tiet dien chu nhat
M = Abs(M)
N = Abs(N)
'===== Tinh cho truong hop bo qua Momen
Fadungtam = ((N / Phi - Rn * b * h)) / Ra
'===============================
MuyGt = 2 * MuyMin
Muy = MuyGt
Do
MuyGt = (MuyGt + Muy) / 2
If MuyGt < 0 Then Exit Do
Jb = b * h ^ 3 / 12
Ja = 0.01 * MuyGt * b * (h - ao) * (0.5 * h - ao) * (0.5 * h - ao)
'===================================Tinh toan do lech tam eo
If b > 0.25 And h / 25 > 0.02 Then
Eo = (M / N + h / 25)
ElseIf b > 0.25 And h / 25 < 0.02 Then
Eo = (M / N + 0.02)
ElseIf b < 0.25 And h / 25 > 0.015 Then
Eo = (M / N + h / 25)
ElseIf b < 0.25 And h / 25 < 0.015 Then
Eo = (M / N + 0.015)
End If
'================================ Tinh he so anh huong den do lech tam
If Eo < 0.05 * h Then
s = 0.84
ElseIf 0.05 * h <= Eo < 5 * h Then
s = 0.11 / (0.1 + Eo / h) + 0.1
Else
s = 0.122
End If
Nth = 6.4 * ((s * Jb * Eb / Kdh) + Ea * Ja) / (Lo * Lo)
nuy = 1 / (1 - (N / Nth))
If nuy < 0 Then FaCot = "ThiÕu thÐp": Exit Function
eogh = 0.4 * (1.25 * h - Anpha(MBT) * ho)
X = N / Rn / b
If X < Anpha(MBT) * (h - ao) Then
'====================================Tinh toan lech tam lon
If X < 2 * ao Then
FaCot = N * (nuy * Eo - 0.5 * h + ao) / Ra / (ho - ao)
ElseIf X > 2 * ao And X < Anpha(MBT) * ho Then
e = nuy * Eo + 0.5 * h - ao
FaCot = N * (e - ho + 0.5 * X) / (Ra * ho - Ra * ao)
Else
GoTo TinhTheoLechTamBe
End If
Else
TinhTheoLechTamBe:
'=====================================Tinh toan lech tam be
If nuy * Eo <= 0.2 * ho Then
X = h - (1.8 + 0.5 * h / ho - 1.4 * Anpha(MBT)) * Eo
Else
X = 1.8 * (eogh - Eo) + Anpha(MBT) * ho
End If
e = 0.5 * h + nuy * Eo - ao 'Khoang cach tu luc doc den trong tam cot thep chiu keo
FaCot = ((N * e - Rn * b * X * (ho - 0.5 * X)) / Ra / (ho - ao))
End If
'====================================Kiem tra ham luong cot thep
Muy = 200 * FaCot / (b * ho)
Loop Until Abs(Muy - MuyGt) < 0.05
Fat = FaCot
ElseIf M = 0 And N > 0 Then
'===================================Tinh toan cau kien chiu keo trung tam
M = Abs(M)
N = Abs(N)
FaCot = 0.5 * N / Ra
Fat = 0.5 * N / Ra
Muy = 100 * (FaCot + Fat) / (b * ho)
ElseIf M <> 0 And N > 0 Then
M = Abs(M)
N = Abs(N)
Eo = M / N
If Eo <= 0.5 * h - ao Then
'===================================Tinh toan cau kien chiu keo lech tam be
Fat = N * (0.5 * h - Eo - ao) / Ra / (ho - ao)
FaCot = N * (0.5 * h + Eo - ao) / Ra / (ho - ao)
Fat = TimMax(Array(Fat, FaCot))
FaCot = TimMax(Array(Fat, FaCot))
Muy = 100 * (FaCot + Fat) / (b * ho)
Else
'==================================Tinh toan cau kien chiu keo lech tam lon
X = Anpha(MBT) * ho
Fat = (N * (Eo + 0.5 * h - ao) - Anpha(MBT) * (1 - 0.5 * Anpha(MBT)) * Rn * b * ho * ho) / Ra / (ho - ao)
FaCot = (N + Anpha(MBT) * Rn * b * ho + Ra * Fat) / Ra
Fat = TimMax(Array(Fat, FaCot))
FaCot = TimMax(Array(Fat, FaCot))
Muy = 100 * (FaCot + Fat) / (b * ho)
End If
End If
FaCot = TimMax(Array(FaCot, Fadungtam))
If Muy < 1 Then
Muy = 1
Fat = Muy * b * ho / 200
FaCot = Muy * b * ho / 200
Fat = Fat * 10 ^ 4
FaCot = FaCot * 10 ^ 4
Else
FaCot = FaCot * 10 ^ 4
Fat = Fat * 10 ^ 4
End If
End Function[/QUOTE]
xem hộ cái dòng màu đỏ cái.Last edited by pvtdhxd; 29-09-2007, 10:40 AM.
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
bác PMXD thật tâm lý. em đang là sinh viên, học tàng tàng,ko bit VBA nên xin cái bác làm sẵn về dùng lại thấy hay. ai có thể cho mình bit về lập trình VBA ko, kiến thức từ thấp tới cao í
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Từ trước đến giờ em toàn dùng excel để thực hiện.Không cần VBA đâu.Tuy hơi dài 1 chút nhưng chơi được mọi bài toán hết.Chỉ cần sáng tạo chút thôi.Ai thích thì em gửi mấy công thức nội suy trong bảng tra cơ đất cho.Chỉ dùng match và index là chơi được cả 1 chiều và 2 chiều hết.Dĩ nhiên là có hàm sẽ nhanh hơn nhưng ai chưa kịp học cũng có thể dùng ngay mà không cần đi nghiên cứu VBA.
Leave a comment:
-
Ðề: Mỗi tuần một hàm trong Excel!
Tôi thấy chủ đề các bác mở ra là mỗi tuần một hàm Excel, nhưng đọc toàn thấy VB thôi à. Mà viết vài cái lệnh VB thì đâu có khó và chả liên quan gì đến Excel cả. Với các hàm này các bác cứ tự nhiên vào AutoCAD, Word, PowerPoint... hay cái quái gì mà chả dùng được.
Tôi thấy bọn lớp 48 CLC trường Xây dựng được dùng Excel để tính móng nông (có tra bảng, có vẽ biểu đồ ứng suất...) mà toàn dùng đúng các hàm của Excel thôi à (không hề có VB).
Xin mạn phép góp ý với bác PMXD là bác nên mở thêm một chủ đề về lập trình VB thì thích hợp hơn, lúc đó sẽ có nhiều dân IT vào đấy.
Leave a comment:
Quảng cáo cuối trang
Collapse
Leave a comment: