Giúp mình chuyển từ hàm này sang VBA (1 người xem)

hiepga2612 · 17/5/16

Mình hiện là SV 3 chuyên ngành Xây Dựng trường ĐHSPKT TP.HCM
Mình tìm được Hàm Function tính cột như sau

Mã:

Function Ascolumn(n, m, b, h, Rb, Eb, Rs, Es, l)    xiR = (0.85 - 0.008 * Rb) / ((1 + (Rs / 400) * (1 - ((0.85 - 0.008 * Rb) / 1.1))))
    If h / 10 < 50 Then a = 50 Else a = h / 10
    ho = h - a
    Rsc = Rs
    n = Abs(n)
    m = Abs(m)
    '-------------------------------
    ' Chieu dai tinh toan lo =w * l
        lo = 0.7 * l * 1000
    '-------------------------------
    ' Do lech tam tinh hoc e1 =M/N
        e1 = m * 1000 / n
    '--------------------------------
     ' Do lech tam ngau nhien ea = max (l/600 ; h/30)
        If l * 1000 / 600 > h / 30 Then ea = l * 1000 / 600 Else ea = h / 30
    '---------------------------------
    ' Do lech tam ban dau eo:
        ' + eo = max (e1 ; ea) ; he sieu tinh.
        ' + eo = e1 + ea ; he tinh dinh.
        If e1 > ea Then eo = e1 Else eo = ea
    '---------------------------------
    'Tinh luc can toi han Ncr
    ' Ncr = (6.4*Eb/lo^2)*(S*I/fil +anfa*Is)
    '-----------------------------------
      '+ Monment quan tinh cua tiet dien
        i = b * h ^ 3 / 12
     '-----------------------------------
     u = 2
     utt = 2
Do
    u = (u + utt) / 2
      '+ Monment quan tinh cua cot thep
        iss = (u / 100) * b * ho * (0.5 * h - a) ^ 2
    '-----------------------------------
        anfa = Es / Eb
    '-----------------------------------
    ' Tinh S = (0.11 / (0.1 + (tetae / fip))) + 0.1
        fip = 1 ' betong thuong
        tetamin = 0.5 - 0.01 * (lo / h) - 0.01 * Rb
        ' tetae = max ( eo/h ; tetamin)
        If eo / h > tetamin Then tetae = eo / h Else tetae = tetamin
        S = (0.11 / (0.1 + (tetae / fip))) + 0.1
    '-----------------------------------
        ' He so anh huong cua uon doc
            ' fil = 1 + beta*[(Mdh + Ndh*h/2)/(M + N*h/2)] + 1
            ' beta = 1
            fil = 2
    '-------------------------------------
        Ncr = (6.4 * Eb / lo ^ 2) * (S * i / fil + anfa * iss) * 10 ^ -3
    '----------------------------------------------------------------------------------------
         nuy = 1 / (1 - n / Ncr)
    '----------------------------------------------------------------------------------------
         e = nuy * eo + h / 2 - a
    '----------------------------------------------------------------------------------------
    ' Tinh toan cot thep
        X1 = (n * 1000) / (Rb * b)
           '+ Neu x1 < 2*a NLT lon dac biet:
            '* xichmab = Rb
            '* xichmaS = Rs
            '* xichmaSC < Rsc
            'As = N*(nuy * eo -h/2 +a')/Rs*(ho-a')
         '+ Neu 2a' <= x1 <= (xiR *ho) NLT lon:
            '* xichmab = Rb
            '* xichmaS = Rs
            '* xichmaSC = Rsc
            'As = [Ne- Rb*b*x1*(ho - x1/2)]/[Rsc*(ho-a')]
               '=N*(e-ho+x1/2)/Rs(ho-a')
        '+ Neu x1 >(xiR * ho) NLT be
            '* xichmab = Rb
            '* xichmaS < Rs
            '* xichmaSC = Rsc
            'x2 = {[(1 - xiR) * gamaA * v+ 2*xiR*(v*epxilon-0.48)]ho}/[(1-xiR)*gamaA + 2(v*epxilon - 0.48)]
            'As = [Ne- Rb*b*x2*(ho - x2/2)]/[Rsc*(ho-a')]
        '------------------------------------------------------------------------------------
    Select Case X1
        Case Is < 2 * a ' NLT lon dac biet
            thep = n * 1000 * (nuy * eo - h / 2 + a) / (Rs * (ho - a) * 100)
        '------------------------------------------------------------------------------------
       Case 2 * a To xiR * ho ' NLT lon
            thep = (n * 1000 * e - Rb * b * X1 * (ho - X1 / 2)) / (Rsc * (ho - a) * 100)
        '------------------------------------------------------------------------------------
        Case Is > xiR * ho ' NLT be
            v = n * 1000 / (Rb * b * ho)
            epxilon = e / ho
            gamaA = (ho - a) / ho
            x3 = (((1 - xiR) * gamaA * v + 2 * xiR * (v * epxilon - 0.48)) * ho) / ((1 - xiR) * gamaA + 2 * (v * epxilon - 0.48))
        Select Case x3
            Case Is > ho
                X2 = ho
            Case Is < xiR * ho
                X2 = xiR * ho
            Case Else
                X2 = x3
        End Select
            thep = (n * 1000 * e - Rb * b * X2 * (ho - 0.5 * X2)) / (Rsc * (ho - a) * 100)
        '------------------------------------------------------------------------------------
    End Select
        utt = (2 * 10000 * thep) / (b * ho)
        If u > utt Then Min = utt Else Min = u
   Loop Until (Abs(u - utt) / Min) < 0.01
   Ascolumn = Round(thep, 2)
End Function

Nhưng khi mình chuyển thành sub CMD như thế này lại ko được, ko biết sai lỗi nào pác nào giúp mình với

Mã:

Private Sub TT_Click()'-------------------Function Ascolumn(n, m, b, h, Rb, Eb, Rs, Es, l)
i = 10
While Sheet5.Cells(i, "A") <> 0
    n = Abs(Sheet5.Cells(i, "D"))
    m = Abs(Sheet5.Cells(i, "E"))
    Rb = Sheet5.Cells(2, "B")
    Rs = Sheet5.Cells(2, "D")
    Eb = Sheet5.Cells(2, "H")
    Es = Sheet5.Cells(2, "J")
    b = Sheet5.Cells(i, "F")
    h = Sheet5.Cells(i, "G")
    l = Sheet5.Cells(i, "I")
    xiR = (0.85 - 0.008 * Rb) / ((1 + (Rs / 400) * (1 - ((0.85 - 0.008 * Rb) / 1.1))))
    If h / 10 < 50 Then a = 50 Else a = h / 10
    ho = h - a
    Rsc = Rs
    '-------------------------------
    ' Chieu dai tinh toan lo =w * l
        lo = 0.7 * l * 1000
    '-------------------------------
    ' Do lech tam tinh hoc e1 =M/N
        e1 = m * 1000 / n
    '--------------------------------
     ' Do lech tam ngau nhien ea = max (l/600 ; h/30)
        If l * 1000 / 600 > h / 30 Then ea = l * 1000 / 600 Else ea = h / 30
    '---------------------------------
        If e1 > ea Then eo = e1 Else eo = ea
    '-----------------------------------
      '+ Monment quan tinh cua tiet dien
        i = b * h ^ 3 / 12
     '-----------------------------------
     u = 2
     utt = 2
Do
    u = (u + utt) / 2
      '+ Monment quan tinh cua cot thep
        iss = (u / 100) * b * ho * (0.5 * h - a) ^ 2
    '-----------------------------------
        anfa = Es / Eb
    '-----------------------------------
        fip = 1 ' betong thuong
        tetamin = 0.5 - 0.01 * (lo / h) - 0.01 * Rb
        If eo / h > tetamin Then tetae = eo / h Else tetae = tetamin
        S = (0.11 / (0.1 + (tetae / fip))) + 0.1
            fil = 2
    '-------------------------------------
        Ncr = (6.4 * Eb / lo ^ 2) * (S * i / fil + anfa * iss) * 10 ^ -3
    '----------------------------------------------------------------------------------------
         nuy = 1 / (1 - n / Ncr)
    '----------------------------------------------------------------------------------------
         e = nuy * eo + h / 2 - a
    '----------------------------------------------------------------------------------------
    ' Tinh toan cot thep
        X1 = (n * 1000) / (Rb * b)
        '------------------------------------------------------------------------------------
    Select Case X1
        Case Is < 2 * a ' NLT lon dac biet
            thep = n * 1000 * (nuy * eo - h / 2 + a) / (Rs * (ho - a) * 100)
        '------------------------------------------------------------------------------------
       Case 2 * a To xiR * ho ' NLT lon
            thep = (n * 1000 * e - Rb * b * X1 * (ho - X1 / 2)) / (Rsc * (ho - a) * 100)
        '------------------------------------------------------------------------------------
        Case Is > xiR * ho ' NLT be
            v = n * 1000 / (Rb * b * ho)
            epxilon = e / ho
            gamaA = (ho - a) / ho
            x3 = (((1 - xiR) * gamaA * v + 2 * xiR * (v * epxilon - 0.48)) * ho) / ((1 - xiR) * gamaA + 2 * (v * epxilon - 0.48))
        Select Case x3
            Case Is > ho
                X2 = ho
            Case Is < xiR * ho
                X2 = xiR * ho
            Case Else
                X2 = x3
        End Select
            thep = (n * 1000 * e - Rb * b * X2 * (ho - 0.5 * X2)) / (Rsc * (ho - a) * 100)
        '------------------------------------------------------------------------------------
    End Select
        utt = (2 * 10000 * thep) / (b * ho)
        If u > utt Then Min = utt Else Min = u
   Loop Until (Abs(u - utt) / Min) < 0.01
   tinhthep = Round(thep, 2)
   Sheet5.Cells(i, "K") = tinhthep
   i = i + 1
Wend
End Sub

dhn46 · 17/5/16

Bạn nên chuyển như thế này

Mã:

Sub TinhThep()
    'Khoi tao gia tri bien i
    i = 10
    While Sheet5.Cells(i, "A") <> 0
    'Gan gia tri tham so
    n = Abs(Sheet5.Cells(i, "D"))
    m = Abs(Sheet5.Cells(i, "E"))
    Rb = Sheet5.Cells(2, "B")
    Rs = Sheet5.Cells(2, "D")
    Eb = Sheet5.Cells(2, "H")
    Es = Sheet5.Cells(2, "J")
    b = Sheet5.Cells(i, "F")
    h = Sheet5.Cells(i, "G")
    l = Sheet5.Cells(i, "I")
    'Tinh gia tri theo ham da viet
    KQ = Ascolumn(n, m, b, h, Rb, Eb, Rs, Es, l)
    'Dua du lieu xuong sheet
    Sheet5.Cells(i, "K") = KQ
    i = i + 1
    Wend
End Sub

Gọi hàm và truyền tham số.

hiepga2612 · 17/5/16

dhn46 đã viết:

Bạn nên chuyển như thế này

Mã:

Sub TinhThep()
    'Khoi tao gia tri bien i
    i = 10
    While Sheet5.Cells(i, "A") <> 0
    'Gan gia tri tham so
    n = Abs(Sheet5.Cells(i, "D"))
    m = Abs(Sheet5.Cells(i, "E"))
    Rb = Sheet5.Cells(2, "B")
    Rs = Sheet5.Cells(2, "D")
    Eb = Sheet5.Cells(2, "H")
    Es = Sheet5.Cells(2, "J")
    b = Sheet5.Cells(i, "F")
    h = Sheet5.Cells(i, "G")
    l = Sheet5.Cells(i, "I")
    'Tinh gia tri theo ham da viet
    KQ = Ascolumn(n, m, b, h, Rb, Eb, Rs, Es, l)
    'Dua du lieu xuong sheet
    Sheet5.Cells(i, "K") = KQ
    i = i + 1
    Wend
End Sub

Gọi hàm và truyền tham số.

Đầu tiên là cảm ơn bạn, nhưng mình đã thử rất nhìu lần cách của bạn và bị báo lỗi kết quả như thế này ko biết fix sao

dhn46 · 17/5/16

Cũng nói thật với bạn là không biết bạn áp dụng như thế nào, các tham chiếu có đúng hay không.

Những tư vấn trên là hoàn toàn dựa vào những gì bạn viết.

Bạn check lại các tham chiếu xem như thế nào. Nếu lỗi thì lỗi tô màu tại đâu để bạn thay đổi.

hiepga2612 · 17/5/16

dhn46 đã viết:
Cũng nói thật với bạn là không biết bạn áp dụng như thế nào, các tham chiếu có đúng hay không.

Những tư vấn trên là hoàn toàn dựa vào những gì bạn viết.

Bạn check lại các tham chiếu xem như thế nào. Nếu lỗi thì lỗi tô màu tại đâu để bạn thay đổi.

Đây bạn Code hoàn toàn hoạt động chạy ra Kết Quả nhưng lại bị lỗi '1004' ko biết lỗi nào ~~ :.,

HieuCD · 17/5/16

hiepga2612 đã viết:
Đây bạn Code hoàn toàn hoạt động chạy ra Kết Quả nhưng lại bị lỗi '1004' ko biết lỗi nào ~~
View attachment 159150 View attachment 159151 View attachment 159152

bạn đổi biến i thành j xem sao

hiepga2612 · 17/5/16

HieuCD đã viết:
bạn đổi biến i thành j xem sao

Biến đổi i thành j thì ko biết cái này sẽ trở thành gì luôn đó bạn -+*/

HieuCD · 17/5/16

hiepga2612 đã viết:
Biến đổi i thành j thì ko biết cái này sẽ trở thành gì luôn đó bạn

bạn có thử chưa mà tuyên bố hùng hồn vậy?

dhn46 · 17/5/16

Theo hình thì thấy function vẫn chạy đúng, lỗi phần đập xuống sheets
Bạn kiểm tra xem có sheets code 5 trong file không? Nhớ là sheet code không phải sheet name, không được thì đưa file lên đây

hiepga2612 · 17/5/16

dhn46 đã viết:
Theo hình thì thấy function vẫn chạy đúng, lỗi phần đập xuống sheets
Bạn kiểm tra xem có sheets code 5 trong file không? Nhớ là sheet code không phải sheet name, không được thì đưa file lên đây

He he cảm ơn bạn, nhưng mình đã mò ra = cách lệnh gọi hàm (Call) :")

Ngoài ra mình còn 1 vấn đề thắc mắc ở topic này hi vọng bạn sẽ qua giải đáp.
http://www.giaiphapexcel.com/forum/showthread.php?114841-hỏi-về-cách-Lọc-lấy-dữ-liệu-thuộc-tính

Giúp mình chuyển từ hàm này sang VBA (1 người xem)

Người dùng đang xem chủ đề này

hiepga2612

Thành viên mới

dhn46

Hướng tới tương lai

hiepga2612

Thành viên mới

dhn46

Hướng tới tương lai

hiepga2612

Thành viên mới

HieuCD

Chuyên gia GPE

hiepga2612

Thành viên mới

HieuCD

Chuyên gia GPE

dhn46

Hướng tới tương lai

hiepga2612

Thành viên mới

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

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