Tính lún theo đường cong T-Z

[tranvanhung2009]

Xin chào mọi người, mình đã viết 1 đoạn code trong file đính kèm.
Trong đó có hàm Private Function DuongCongTZ , mình đã viết vòng lặp để tính lún, vòng lặp có chạy trong Sub tinhw() nhưng không cho ra kết quả.
Mong mọi người kiểm tra giúp mình với, nội dung mình đã ghi cụ thể trong Sheet1
Cám ơn mọi người nhiều!

 

[HieuCD]

Xin chào mọi người, mình đã viết 1 đoạn code trong file đính kèm.
Trong đó có hàm Private Function DuongCongTZ , mình đã viết vòng lặp để tính lún, vòng lặp có chạy trong Sub tinhw() nhưng không cho ra kết quả.
Mong mọi người kiểm tra giúp mình với, nội dung mình đã ghi cụ thể trong Sheet1
Cám ơn mọi người nhiều!

Tìm nghiệm gần đúng phải có bước nhảy linh hoạt

Option Explicit
Dim arr(), kb#, kt#, A#, E#, L#, d#
Private Function DuongCongTZ(ByVal Luc_F As Double, _
            Optional ByVal buoc_nhay As Double = 1, _
            Optional ByVal sai_so As Double = 0.5) As Double
  Dim tong#, P#, i&, tmp

  Do While P < Luc_F
    arr(1, 1) = P 'Phan luc doan 1
    arr(1, 2) = P / A   'ung suat tai doan 1
    arr(1, 3) = P / kb + P * 1 / (A * E) ' Chuyen vi doan 1
    tong = arr(1, 3)
    For i = 2 To L
      arr(i, 1) = arr(i - 1, 3) * kt ' Phan luc dong i = chuyen vi dong (i-1)*KT
      arr(i, 2) = arr(i - 1, 2) + arr(i, 1) / A 'ung suat hang thu i = ung suat dong (i-1)+Phan luc tinh duoc o dong i*/A
      arr(i, 3) = arr(i, 1) / kt + arr(i, 1) * 1 / (E * A)  'chuyen vi hang thu i = Phan luc dong k/kt+phan luc dong k /EA
      tong = tong + arr(i, 3) ' Tinh tong do lun cua cot 3 trong mang cua 1 vong lap
    Next i
    tmp = arr(L, 2) * A
    If Abs(tmp - Luc_F) <= sai_so Then
      DuongCongTZ = tong
      Exit Function
    End If
    If tmp < Luc_F Then
      P = P + buoc_nhay
    Else
      P = P - buoc_nhay
      buoc_nhay = buoc_nhay / 2
    End If
  Loop
End Function

Sub tinhw()
  Dim i&
  With Thongso
    L = .Range("Chieu_dai")
    d = .Range("Duong_kinh")
    E = .Range("Mo_dun_vat_lieu")
    A = Application.Pi() * d ^ 2 / 4
  End With
  ReDim arr(1 To L, 3)
  kb = 1000:  kt = 5000
 
  With ketqua
    For i = 11 To 14
      Cells(i, 4) = DuongCongTZ(Cells(i, 3), 1, 0.1)
    Next i
  End With
End Sub

 

[tranvanhung2009]

Cảm ơn anh rất nhiều!

 

[tranvanhung2009]

Nhờ anh thêm giúp em đoạn code để trích tiếp kết quả trên View attachment 258291

Bài đã được tự động gộp: 9/5/21

Tìm nghiệm gần đúng phải có bước nhảy linh hoạt

Option Explicit
Dim arr(), kb#, kt#, A#, E#, L#, d#
Private Function DuongCongTZ(ByVal Luc_F As Double, _
            Optional ByVal buoc_nhay As Double = 1, _
            Optional ByVal sai_so As Double = 0.5) As Double
  Dim tong#, P#, i&, tmp

  Do While P < Luc_F
    arr(1, 1) = P 'Phan luc doan 1
    arr(1, 2) = P / A   'ung suat tai doan 1
    arr(1, 3) = P / kb + P * 1 / (A * E) ' Chuyen vi doan 1
    tong = arr(1, 3)
    For i = 2 To L
      arr(i, 1) = arr(i - 1, 3) * kt ' Phan luc dong i = chuyen vi dong (i-1)*KT
      arr(i, 2) = arr(i - 1, 2) + arr(i, 1) / A 'ung suat hang thu i = ung suat dong (i-1)+Phan luc tinh duoc o dong i*/A
      arr(i, 3) = arr(i, 1) / kt + arr(i, 1) * 1 / (E * A)  'chuyen vi hang thu i = Phan luc dong k/kt+phan luc dong k /EA
      tong = tong + arr(i, 3) ' Tinh tong do lun cua cot 3 trong mang cua 1 vong lap
    Next i
    tmp = arr(L, 2) * A
    If Abs(tmp - Luc_F) <= sai_so Then
      DuongCongTZ = tong
      Exit Function
    End If
    If tmp < Luc_F Then
      P = P + buoc_nhay
    Else
      P = P - buoc_nhay
      buoc_nhay = buoc_nhay / 2
    End If
  Loop
End Function

Sub tinhw()
  Dim i&
  With Thongso
    L = .Range("Chieu_dai")
    d = .Range("Duong_kinh")
    E = .Range("Mo_dun_vat_lieu")
    A = Application.Pi() * d ^ 2 / 4
  End With
  ReDim arr(1 To L, 3)
  kb = 1000:  kt = 5000

  With ketqua
    For i = 11 To 14
      Cells(i, 4) = DuongCongTZ(Cells(i, 3), 1, 0.1)
    Next i
  End With
End Sub

Nhờ anh thêm giúp em đoạn code để trích tiếp kết quả trên

 

[HieuCD]

Nhờ anh thêm giúp em đoạn code để trích tiếp kết quả trên View attachment 258291

Bài đã được tự động gộp: 9/5/21

Nhờ anh thêm giúp em đoạn code để trích tiếp kết quả trên
View attachment 258292

Chỉnh lại theo cột

Option Explicit
Private Function TZ(kb#, kt#, A#, E#, L#, d#, Luc_F#, buoc_nhay#, sai_so#) As Variant
  Dim arr(), tong#, P#, j&, pl#, tmp#
 
  ReDim arr(1 To 3, -1 To L + 1)
  Do While P < Luc_F
    arr(3, 1) = P 'Phan luc doan 1
    arr(2, 1) = P / A   'ung suat tai doan 1
    arr(1, 1) = P / kb + P * 1 / (A * E) ' Chuyen vi doan 1
    arr(1, -1) = arr(1, 1) 'Tinh tong do lun
    For j = 2 To L
      arr(3, j) = arr(1, j - 1) * kt ' Phan luc doan j = chuyen vi doan (j-1)*KT
      arr(2, j) = arr(2, j - 1) + arr(3, j) / A 'ung suat doan j= ung suat doan (j-1)+Phan luc tinh duoc o doan j*/A
      arr(1, j) = arr(3, j) / kt + arr(3, j) * 1 / (E * A)  'chuyen vi doan j = Phan luc dong k/kt+phan luc dong k /EA
      arr(1, -1) = arr(1, -1) + arr(1, j) ' Tinh tong do lun
    Next j
    tmp = arr(2, L) * A
    If Abs(tmp - Luc_F) <= sai_so Then
      arr(1, 0) = arr(3, L)
      TZ = arr
      Exit Function
    End If
    If tmp < Luc_F Then
      P = P + buoc_nhay
    Else
      P = P - buoc_nhay
      buoc_nhay = buoc_nhay / 2
    End If
  Loop
End Function

Sub tinhw()
  Dim kb#, kt#, A#, E#, L#, d#, i&
  With Thongso
    L = .Range("Chieu_dai")
    d = .Range("Duong_kinh")
    E = .Range("Mo_dun_vat_lieu")
    A = Application.Pi() * d ^ 2 / 4
  End With
  kb = 1000:  kt = 5000
  With ketqua
    For i = 11 To 14
      Cells(i, 4).Resize(1, L + 2) = TZ(kb#, kt#, A#, E#, L#, d#, Cells(i, 3), 1, 0.1)
    Next i
  End With
End Sub