Giúp em tìm lỗi vòng lặp Do...Loop

  • Thread starter Thread starter ptqc06
  • Ngày gửi Ngày gửi
Liên hệ QC
P

ptqc06

Thành viên mới
Tham gia
10/1/08
Bài viết
6
Được thích
0
Tìm lỗi vòng lặp Do...Loop

Các bác ơi tìm hộ em cái lỗi trong vòng lặp này với; Em mất cả tuần mà chưa tìm ra được.Hic:
PHP: 
    M = Abs(Mx) + beta * h * Abs(My) / b
    x = 0
    i = 1
    dung = False
    Do Until dung = True
        x = x + i * 0.0000001
        i = i + 1
        If x <= C3 Then
            es1 = 0.0035 * (d - x) / x
            es2 = 0.0035 * (x - a) / x '(a = d')
        Else
            es1 = 0.002 * (x - d) / (x - 3 * C3 / 7)
            es2 = 0.002 * (x - a) / (x - 3 * C3 / 7) '(a = d')
        End If
        
        fs1 = es1 / Es
        fs2 = es2 / Es
        
        Ast1 = (Abs(N) - fcu * C2 * 0.9 * x) / (fs1 + fs2)
        Ast2 = (Abs(M) - fcu * C2 * s * (0.5 * C3 - 0.5 * 0.9 * x)) / ((fs2 - fs1) * (d - 0.5 * C3))
        Ktra = Ast1 - Ast2
        
        If Ktra < 1 Then
            dung = True
        End If
    Loop
    ltxbs = As1 * 10000
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Đưa cả chương trình và mục đích của nó lên đi bạn!
 
Upvote 0
Bạn có thể nêu rõ thông báo lỗi là gì không? hoặc khi chạy chương trình báo lỗi và debug tại dòng nào vậy? Chứ như thế này mình cũng không biết trả lời sao nữa!
 
Upvote 0
Hơi lạc đề chút nhưng bác SA_DQ cảm ơn làm em ngại quá đi mất! Không có nhiều thời gian nên đôi khi viết ngắn nhất có thể, những bài viết như trên của em nên xóa sau khi chủ topic đã viết yêu cầu đầy đủ.
Thân!
 
Upvote 0
Cái hàm này em viết để tính thép lệch tâm xiên theo bs.
Em không hiêu vì sao nó ko chịu tính vòng lặp chứ không gặp lỗi gì hết.
Dưới đây là toàn bộ hàm tính:(mọi người xem phần vòng lặp hộ em thôi)

'Tinh lech tam xien theo BS
Public Function ltxbs(MacBT As String, MacThep As String, N As Double, M2 As Double, M3 As Double, le2 As Double, le3 As Double, C2 As Double, C3 As Double, a As Double) As Double
Dim Rb, Eb, Fy, Es As Double
Dim b, h, d, x As Double
Dim M, Mx, My As Double
Dim es1, es2 As Double
Dim Ast1, Ast2 As Double
Dim anpha, tanganpha, beta As Double
Dim i, j As Long
Dim dung As Boolean
Dim Ktra As Double

'Kiem tra macBT va macThep
Select Case MacBT
Case "B12.5"
Rb = 7.5 '(MPa)
Eb = 21000


Case "B15"
Rb = 8.5 '(MPa)
Eb = 23000


Case "B20"
Rb = 11.5 '(MPa)
Eb = 27000


Case "B25"
Rb = 14.5 '(MPa)
Eb = 30000


Case "B30"
Rb = 17 '(MPa)
Eb = 32500



Case "B35"
Rb = 19.5 '(MPa)
Eb = 34500


Case "B40"
Rb = 22 '(MPa)
Eb = 36000


Case "B45"
Rb = 25 '(MPa)
Eb = 37500


Case "B50"
Rb = 27.5 '(MPa)
Eb = 39000


Case "B55"
Rb = 30 '(MPa)
Eb = 39500 '(MPa)


Case "B60"
Rb = 33 '(MPa)
Eb = 40000

End Select

Select Case MacThep
Case "AI"
Fy = 225 '(Mpa)
Es = 210000
Case "CI"
Fy = 225 '(Mpa)
Es = 210000

Case "AII"
Fy = 280 '(Mpa)
Es = 210000
Case "CII"
Fy = 280 '(Mpa)
Es = 210000

Case "AIII"
Fy = 365 '(Mpa)
Es = 200000
Case "CIII"
Fy = 365 '(Mpa)
Es = 200000

Case "AIV"
Fy = 510 '(Mpa)
Es = 190000
Case "CIV"
Fy = 510 '(Mpa)
Es = 190000

Case "AV"
Fy = 680 '(Mpa)
Es = 190000

Case "AVI"
Fy = 815 '(Mpa)
Es = 190000
Case "AVI"
Fy = 815 '(Mpa)
Es = 190000

Case "AVII"
Fy = 980 '(Mpa)
Es = 190000

End Select

Dim trabeta(1 To 2, 1 To 7) As Range
trabeta(1, 1) = 0
trabeta(1, 2) = 0.1
trabeta(1, 3) = 0.2
trabeta(1, 4) = 0.3
trabeta(1, 5) = 0.4
trabeta(1, 6) = 0.5
trabeta(1, 7) = 0.6
trabeta(2, 1) = 1
trabeta(2, 2) = 0.88
trabeta(2, 3) = 0.77
trabeta(2, 4) = 0.65
trabeta(2, 5) = 0.53
trabeta(2, 6) = 0.42
trabeta(2, 7) = 0.3

fcu = Rb
anpha = Abs(N) / (C2 * C3 * fcu * 1000) '1000 la doi don vi:1MPa = 1000KN/m2
For i = 1 To UBound(trabeta, 1)
If anpha = trabeta(1, i) Then
beta = trabeta(2, i)
ElseIf (anpha - trabeta(1, i)) * (anpha - trabeta(1, i + 1)) <= 0 Then
tanganpha = (trabeta(2, i) - trabeta(2, i + 1)) / (trabeta(1, i) - trabeta(1, i + 1))
beta = anpha * tanganpha
ElseIf anpha > 0.6 Then beta = 0.3
End If
Next

If le2 / C2 < 15 And le3 / C3 < 15 Then
Mx = M3
My = M2
h = C3 - a
b = C2 - a



If Abs(Mx) / h > Abs(My) / b Then

M = Abs(Mx) + beta * h * Abs(My) / b
x = 0
i = 1
dung = False
Do Until dung = True
x = x + i * 0.0000001
i = i + 1
If x <= C3 Then
es1 = 0.0035 * (d - x) / x
es2 = 0.0035 * (x - a) / x '(a = d')
Else
es1 = 0.002 * (x - d) / (x - 3 * C3 / 7)
es2 = 0.002 * (x - a) / (x - 3 * C3 / 7) '(a = d')
End If

fs1 = es1 / Es
fs2 = es2 / Es

Ast1 = (Abs(N) - fcu * C2 * 0.9 * x) / (fs1 + fs2)
Ast2 = (Abs(M) - fcu * C2 * s * (0.5 * C3 - 0.5 * 0.9 * x)) / ((fs2 - fs1) * (d - 0.5 * C3))
Ktra = Ast1 - Ast2
If Ktra = 0 Then
dung = True
Exit Do
End If
Loop
ltxbs = As1 * 10000

Else

M = Abs(My) + beta * b * Abs(Mx) / h
x = 0
i = 1
dung = False
Do Until dung = True
x = x + j * 0.00001
j = j + 1
If x <= C2 Then
es1 = 0.0035 * (d - x) / x
es2 = 0.0035 * (x - a) / x '(a = d')
Else
es1 = 0.002 * (x - d) / (x - 3 * C2 / 7)
es2 = 0.002 * (x - a) / (x - 3 * C2 / 7) '(a = d')
End If

fs1 = es1 / Es
fs2 = es2 / Es

Ast1 = (Abs(N) - fcu * C3 * 0.9 * x) / (fs1 + fs2)
Ast2 = (Abs(M) - fcu * C3 * s * (0.5 * C2 - 0.5 * 0.9 * x)) / ((fs2 - fs1) * (d - 0.5 * C2))
Ktra = Ast1 - Ast2
If Ktra = 0 Then
dung = True
Exit Do
End If
Loop
ltxbs = As1 * 10000
End If

End If

End Function
 
Upvote 0
-Bước đầu mình thấy được chỗ này:
Dim trabeta(1 To 2, 1 To 7) As Range
trabeta(1, 1) = 0
trabeta(1, 2) = 0.1
trabeta(1, 3) = 0.2
trabeta(1, 4) = 0.3
trabeta(1, 5) = 0.4
trabeta(1, 6) = 0.5
trabeta(1, 7) = 0.6
Nhấp chuột vào đây để mở rộng...
Bạn thử chỉnh lại xem:
Dim trabeta(1 To 2, 1 To 7) As Double
 
Upvote 0
Đây chỉ là i kiến ban đầu, có khi chưa đúng đâu nha!

Phần đầu chương trình mình đề xuất như vầy, bạn có thể kiểm chứng lúc rỗi:
Bạn lập bảng tra cho 4 giá trị, tuy nhiên mình nói trước: có khi chưa chắc phù hợp với bạn không chừng.

PHP: 
Option Explicit
'Tinh lech tam xien theo BS'
Public Function LTXBS(MacBT As String, MacThep As String, N As Double, M2 As Double, M3 As _
   Double, le2 As Double, le3 As Double, C2 As Double, C3 As Double, a As Double) As Double
Dim Rb, Eb, Fy, Es As Double
Dim b, h, d, x As Double
Dim M, Mx, My As Double
Dim es1, es2 As Double
Dim Ast1, Ast2 As Double
Dim anpha, tanganpha, beta As Double
Dim i, j As Long
Dim dung As Boolean
Dim Ktra As Double
' Nhung Bien Ban Chua Khai Bao Tuong Minh:'
Dim fcu As Double, fs1 As Double, fs2 As Double, s As Double, As1 As Double 
'*'
 Rb = WorksheetFunction.VLookup(MacBT, Sheet1.Range("Table1"), 2, 0)
 Eb = WorksheetFunction.VLookup(MacBT, Sheet1.Range("$A$1:$C$16"), 3, 0)
 If Left(MacThep, 1) = "C" Then MacThep = "A" & Mid(MacThep, 2)
 Fy = WorksheetFunction.VLookup(MacThep, Sheet1.Range("Table2"), 2, 0)
 Es = WorksheetFunction.VLookup(MacThep, Sheet1.Range("$d$1:$f$16"), 3, 0)
 7
 Select Case N
 Case 1
    LTXBS = Rb
 Case 2
   LTXBS = Eb
 Case 3
   LTXBS = Fy
 Case 4
   LTXBS = Es
 End Select
 Exit Function

 End Function

(*) các câu lệnh sau dòng 7 chỉ để kiểm tra từng bước khi viết hàm mà thôi. (Thực tiển của loại người tự học như mình ấy mà! Thông cảm nha)

Mình cũng xin mạnh dạn góp vài í với bạn:
Bạn rất cần nhiều biến; nhưng tên biến của bạn hoặc quá dài hay quá ngắn;
Ngắn như: N, b, , D, X . . . . (Tất nhiên 1 số chữ cái đã thông dụng như h: độ cao; S diện tích, P - áp xuất. . . thì mình không dám phế phán.
Dài như Macthep, (chỉ nên: MThep, hay MacTh giống như MacBT bạn đã xài); Tanganpha mà sao không là TgAlfa

Rất mong í kiến phản hồi từ bạn.
 
Upvote 0
Cám ơn các bạn đã góp ý.Vì mình mới thử làm với vba nên còn nhiều chỗ chưa chuyên nghiệp.Mình sẽ cố sữa những lỗi đó.Tuy nhiên các bạn xem kĩ hộ mình phần vòng lặp í.Không hiểu vì sao nó ko chịu vào đến vòng lặp.Chỉ dừng ở trứoc vòng lặp.Mình xóa phần vòng lặp đi thì phần truớc chạy rất ổn không sao cả
 
Upvote 0
Cám ơn các bạn đã góp ý.Vì mình mới thử làm với vba nên còn nhiều chỗ chưa chuyên nghiệp.Mình sẽ cố sữa những lỗi đó.
Nhấp chuột vào đây để mở rộng...
Theo mình, càng không chuyên nghiệp, càng phải chân phương nhất & tường minh nhất! (Cũng chỉ mong chúng ta cùng tấn tới thôi!)
Ví dụ nếu bạn chịu khó lùi các dòng lệnh, như mình làm dưới kia, có phải dễ nhìn hơn không(?), & vì vậy, sẽ có thêm người xăm soi tác phẩm của bạn hơn nữa kia đấy!
Nói bạn dừng zận, chứ bé mới 4 tháng tuổi thì đừng cho nó học đi

Tuy nhiên các bạn xem kĩ hộ mình phần vòng lặp í.Không hiểu vì sao nó ko chịu vào đến vòng lặp.Chỉ dừng ở trứoc vòng lặp.Mình xóa phần vòng lặp đi thì phần truớc chạy rất ổn không sao cả
Nhấp chuột vào đây để mở rộng...
Bạn nói tời vòng lặp nào, trong For. . . Next
hay trong các vòng Do . . . .Loop vậy

Mà có lẻ bạn nên đưa 1 số số liệu mà hàm cần lên, để bọn này có dịp thử từng công đoạn hàm của bạn mới thấy hết vấn đề được!

PHP: 
Option Explicit:                 Option Base 1
'Tinh lech tam xien theo BS'
Public Function LTXBS(MacBT As String, MacTh As String, N As Double, M2 As Double, M3 As _
   Double, le2 As Double, le3 As Double, C2 As Double, C3 As Double, a As Double) As Double
Dim Rb, Eb, Fy, Es As Double
Dim b, h, d, x As Double
Dim M, Mx, My As Double
Dim es1, es2 As Double
Dim Ast1, Ast2 As Double
Dim Alfa, TgAlfa, beta As Double
Dim i, j As Long
Dim dung As Boolean
Dim Ktra As Double

 Rb = WorksheetFunction.VLookup(MacBT, Sheet1.Range("Table1"), 2, 0)
 Eb = WorksheetFunction.VLookup(MacBT, Sheet1.Range("$A$1:$C$16"), 3, 0)
 If Left(MacTh, 1) = "C" Then MacTh = "A" & Mid(MacTh, 2)
 Fy = WorksheetFunction.VLookup(MacTh, Sheet1.Range("Table2"), 2, 0)
 Es = WorksheetFunction.VLookup(MacTh, Sheet1.Range("$d$1:$f$16"), 3, 0)

ReDim Trabeta(2, 7) As Double  'As Range;   'Chua Khai Bao Nhung Bien Duoi Day:
Dim fCu As Double, fs1 As Double, fs2 As Double, s As Double, As1 As Double

For fCu = 1 To 7
   Trabeta(1, fCu) = (fCu - 1) / 10
   Trabeta(2, fCu) = Choose(fCu, 1, 0.88, 0.77, 0.65, 0.53, 0.42, 0.3)
Next fCu
12
fCu = Rb

Alfa = Abs(N) / (C2 * C3 * fCu * 1000) '1000 la doi don vi:1MPa = 1000KN/m2'
For i = 1 To UBound(Trabeta, 1)
   If Alfa = Trabeta(1, i) Then
      beta = Trabeta(2, i)
   ElseIf (Alfa - Trabeta(1, i)) * (Alfa - Trabeta(1, i + 1)) <= 0 Then
      TgAlfa = (Trabeta(2, i) - Trabeta(2, i + 1)) / (Trabeta(1, i) - Trabeta(1, i + 1))
      beta = Alfa * TgAlfa
   ElseIf Alfa > 0.6 Then beta = 0.3
   End If
Next

If le2 / C2 < 15 And le3 / C3 < 15 Then
   Mx = M3:                         My = M2
   h = C3 - a:                      b = C2 - a

   If Abs(Mx) / h > Abs(My) / b Then

      M = Abs(Mx) + beta * h * Abs(My) / b
      x = 0:                        i = 1
      dung = False
      Do Until dung = True
         x = x + i * 0.0000001
         i = i + 1
         If x <= C3 Then
            es1 = 0.0035 * (d - x) / x
            es2 = 0.0035 * (x - a) / x '(a = d')
         Else
            es1 = 0.002 * (x - d) / (x - 3 * C3 / 7)
            es2 = 0.002 * (x - a) / (x - 3 * C3 / 7) '(a = d')
         End If

         fs1 = es1 / Es:            fs2 = es2 / Es

         Ast1 = (Abs(N) - fCu * C2 * 0.9 * x) / (fs1 + fs2)
         Ast2 = (Abs(M) - fCu * C2 * s * (0.5 * C3 - 0.5 * 0.9 * x)) / _
            ((fs2 - fs1) * (d - 0.5 * C3))
         Ktra = Ast1 - Ast2
         If Ktra = 0 Then
            dung = True:             Exit Do
         End If
      Loop
      LTXBS = As1 * 10000

   Else
      M = Abs(My) + beta * b * Abs(Mx) / h
      x = 0:                         i = 1
      dung = False
      Do Until dung = True
         x = x + j * 0.00001
         j = j + 1
         If x <= C2 Then
            es1 = 0.0035 * (d - x) / x
            es2 = 0.0035 * (x - a) / x '(a = d')
         Else
            es1 = 0.002 * (x - d) / (x - 3 * C2 / 7)
            es2 = 0.002 * (x - a) / (x - 3 * C2 / 7) '(a = d')
         End If

         fs1 = es1 / Es:            fs2 = es2 / Es
         Ast1 = (Abs(N) - fCu * C3 * 0.9 * x) / (fs1 + fs2)
         Ast2 = (Abs(M) - fCu * C3 * s * (0.5 * C2 - 0.5 * 0.9 * x)) / _
            ((fs2 - fs1) * (d - 0.5 * C2))
         Ktra = Ast1 - Ast2
         If Ktra = 0 Then
            dung = True:             Exit Do
         End If
      Loop
      LTXBS = As1 * 10000
   End If
End If
End Function
 
Upvote 0
Tối nay mình đi Quảng bình rồi.Mình pót file tính lên các bạn xem nhé.Sau khi sửa 1 chút thì vòng lặp chạy mãi không có hồi kết nên treo máy :D.
Các bạn tìm điều kiện hộ mình với nhé.
Nguyên tắc là khi nào Ast1=Ast2 thì dừng.(vòng lặp do í)
Cám ơn trước nhiều nhé
http://www.mediafire.com/?fc1ndzjwcfo
 
Upvote 0
Sao không ai tìm lỗi hộ mình nữa à. Các cao thủ ơi cứu hộ cái đi.
 
Upvote 0

Điều kiện để Exit Do cũng không nên để là If Ktra = 0 Then
vì bạn nghĩ xem: Rất khó cho Ktra chính xác là =0.
Ở vòng lặp này Ktra gần bằng 0 nhưng vẫn lớn hơn 0, sang vòng sau thì nó lại nhỏ hơn không tý xíu,
và sang các vòng lặp sau nó càng ngày càng nhỏ hơn 0 => vòng lặp vô tận.

Bạn nên đặt If ABS(Ktra)< 0.0001 hoặc If ABS(Ktra)< 0.0000000001
Số nhỏ bao nhiêu là tùy ý bạn cần độ chính xác là bao nhiêu để Exit Do.





 
Upvote 0
Ktra = Ast1 - Ast2
' If Ast1 > 0 And Ast2 > 0 Then
Ktra = Ast1 - Ast2
If Abs(Ktra) < 0.00001 Then
dung = True
Exit Do
Else: dung = False
End If
' End If


Bạn có đảm bảo chắc chắn là sẽ dẫn đến điều kiện sẽ thõa không?

Phải chắc chắn đến lúc nào đó sẽ có Ast1 và Ast2 đồng thời lớn hơn 0.

Nếu không đảm bảo điều đó thì bỏ dòng đó đi.
Vì ta chỉ cần kiểm tra Ast1 và Ast2 gần bằng nhau thì cho ngưng vòng lặp.


Tôi sửa lại như vậy thì chạy được.
Bạn xem thử.

http://www.mediafire.com/?jwwahswhgdz
 
Upvote 0
Cám ơn bạn mình giải quyết đuợc rồi!!!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

chaungo898
Lỗi khi sử dụng Excel Mong các a giúp đỡ
Trả lời
12
Đọc
206
HeSanbi
HeSanbi
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
26
Đọc
10K
xanh123
X
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
7
Đọc
1K
dihoathienvu
D
ERX_Vietnam
Xuống dòng trong chuỗi ký tự
Trả lời
11
Đọc
16K
anhtam9zz
A
H
[xin trợ giúp] Tạo tra cứu dữ liệu hàng ngang thành hàng dọc
Trả lời
4
Đọc
106
hoangfe3o4
H
meomap1904
CÁCH VIẾT HÀM KHI Ô DỮ LIỆU BỊ MERGE
Trả lời
7
Đọc
94
Duy Tùng 9x
Duy Tùng 9x
minhminh040499
Filter không hoạt động.
    • Cười
Trả lời
3
Đọc
75
BuiQuangThuan
B
Nami_kc
Không copy paste nội dung giữa các sheet và file excel được
Trả lời
1
Đọc
32
phansythao
phansythao
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL KẾT HỢP VỚI GOOGLE SHEETS ỨNG DỤNG THỰC TẾ
    • Thích
Trả lời
6
Đọc
2K
kiendt1973
K
D
Auto refresh sheet
Trả lời
10
Đọc
3K
VetMini
V
B
Excel tự đẻ thêm ra file đuôi 000
Trả lời
0
Đọc
39
bmtuanltpt
B
L
Nhờ sửa lỗi Hàm If
Trả lời
4
Đọc
121
linhhongphucloc
L
NguyenthiH
Sao dùng Ctl + H thay thế không đúng.
Trả lời
17
Đọc
167
HeSanbi
HeSanbi
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
12
Đọc
328
NguyenthiH
NguyenthiH
ptlong04x1
Làm mất đường đứt nét khi chuyển từ Page Break Preview --> Normal.
Trả lời
10
Đọc
66K
huhumalu
H
H
Thảo luận: Nguyên tắc xác định đơn giá đất ở
    • Thích
Trả lời
1
Đọc
147
PhanTuHuong
PhanTuHuong
NguyenthiH
Tạo Barcode trong Excel để khi quét thì hiện: Tên vật tư,tồn đầu, nhập, xuất, tồn cuối.
Trả lời
2
Đọc
107
NguyenthiH
NguyenthiH
N
  • Question Question
Xin giúp đỡ Code VBA không chạy.
    • Cười
Trả lời
8
Đọc
185
HeSanbi
HeSanbi
N
  • Question Question
[Help] Tổng hợp dữ liệu từ nhiều file excel vào 1 file
Trả lời
2
Đọc
96
DeTong
D
giaiphap
Chia sẻ cách tạo gợi ý cho hàm trong Excel bằng thư viện ExcelDna.
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
15
Đọc
2K
kampria_328
K
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom