Tìm hệ số để nhân để ra kết quả cho trước

[songiang5011]

Em chào anh chị trong diễn đàn, em có file excel nhờ anh chị hỗ trợ giúp em.
Em có dữ liệu tổng chốt (J14), cột D E của em đang nhân với 1 ô hệ số thay đổi (Ô M14), bây giờ em muốn thay đổi dữ liệu Ô M14 sao cho kết quả ô I14-J14=0 (sai số thấp nhất có thể).
Em có dùng Solver nhiều lúc không ra kết quả, hoặc sai số vẫn lớn, Vậy mong anh chị xem xét giúp đỡ em.
Em cám ơn

 

[VetMini]

Làm toán với cả đống số như vậy mà chỉ phải nhận dung sai chưa tới 10 phần triệu như vậy là tốt lắm rồi.

 

[songiang5011]

Làm toán với cả đống số như vậy mà chỉ phải nhận dung sai chưa tới 10 phần triệu như vậy là tốt lắm rồi.

Dạ. Em mong muốn độ lệch ra kết quả thấp nhất có thể

 

[huuthang_bd]

Dạ. Em mong muốn độ lệch ra kết quả thấp nhất có thể

Công thức làm tròn 5 chữ số và sai lệch dưới 10^-5 là kết quả tối ưu rồi.

 

[qthinh4996]

Nguyên nhân là do trong công thức của bạn có nhiều chỗ làm tròn 5 chữ số, nếu muốn ra đúng bằng không thì bỏ làm tròn ra rồi chạy lại.

 

[songiang5011]

Công thức làm tròn 5 chữ số và sai lệch dưới 10^-5 là kết quả tối ưu rồi.

Dạ mỗi lần em chạy solver. Lúc ra kết quả, lúc không, mỗi lần chạy ra một số khác. Em muốn chị chạy 1 lần ra 1 số và muốn độ sai lệch thấp nhất ạ

 

[songiang5011]

Nguyên nhân là do trong công thức của bạn có nhiều chỗ làm tròn 5 chữ số, nếu muốn ra đúng bằng không thì bỏ làm tròn ra rồi chạy lại

Vâng em biết do làm tròn lên ra kết quả bằng 0 chắc không được, nhưng em muốn ra kết quả độ sai lệch thấp nhất có thể. Em chạy solver thì mỗi lần chạy ra 1 số khác, có lúc chạy không ra kết quả. Mong anh giúp đỡ em ạ

 

[huuthang_bd]

Dạ mỗi lần em chạy solver. Lúc ra kết quả, lúc không, mỗi lần chạy ra một số khác. Em muốn chị chạy 1 lần ra 1 số và muốn độ sai lệch thấp nhất ạ

Bạn dùng thử code này:

Sub MySolve()
    Dim rVar As Range, rTarget As Range
    Dim lSign As Long, dDiff As Double, dDiff1 As Double, dDiff2 As Double, dVal As Double, dStep As Double
    Dim i As Long, j As Long, k As Long
    Set rVar = Sheet1.Range("M14")
    Set rTarget = Sheet1.Range("K14")
    Application.Calculation = xlCalculationManual
    dDiff1 = GetValue(rTarget, rVar, 0)
    lSign = Sgn((dDiff1 - Abs(GetValue(rTarget, rVar, 0.1))) * Sgn(dDiff1))
    For i = 0 To 15
        dDiff2 = GetValue(rTarget, rVar, lSign * 10 ^ i)
        If Abs(dDiff2) > Abs(dDiff1) Or Sgn(dDiff2) <> Sgn(dDiff1) Then Exit For
        k = i
        dDiff1 = dDiff2
    Next
    dVal = 0
    dDiff1 = dDiff1 * 2
    For i = k To -15 Step -1
        For j = 1 To 9
            dDiff2 = GetValue(rTarget, rVar, dVal + lSign * 10 ^ i)
            If Abs(dDiff2) > Abs(dDiff1) Then GoTo Next_i
            dVal = dVal + lSign * 10 ^ i
            If Sgn(dDiff2) <> Sgn(dDiff1) Then
                lSign = -lSign
                j = 9
            End If
            dDiff1 = dDiff2
        Next
Next_i:
    Next
    rVar.Value = dVal
    Application.Calculation = xlCalculationAutomatic
End Sub
Private Function GetValue(ByRef rTarget As Range, ByRef rVar As Range, ByVal dVal As Double) As Double
    rVar.Value = dVal
    rTarget.Parent.Calculate
    GetValue = rTarget.Value
End Function

 

[VetMini]

Vâng em biết do làm tròn lên ra kết quả bằng 0 chắc không được, nhưng em muốn ra kết quả độ sai lệch thấp nhất có thể. Em chạy solver thì mỗi lần chạy ra 1 số khác, có lúc chạy không ra kết quả. Mong anh giúp đỡ em ạ

Nếu bạn làm tròn mỗi phần tử thành 5/triệu thì độ dung sai của kết quả không thể thấp hơn số ấy.
Theo nguyên tắc độ dung sai (một bài học trong môn Vật lý lớp 11-12), nếu bạn làm toán 5 phần tử với dung sai 5/triệu thì bạn phải chấp nhận dung sai của kết quả có thể lên tới 5*5/triệu~(5^5)/triệu đơn vị (tùy theo con toán).

 

[songiang5011]

Bạn dùng thử code này:

Sub MySolve()
    Dim rVar As Range, rTarget As Range
    Dim lSign As Long, dDiff As Double, dDiff1 As Double, dDiff2 As Double, dVal As Double, dStep As Double
    Dim i As Long, j As Long, k As Long
    Set rVar = Sheet1.Range("M14")
    Set rTarget = Sheet1.Range("K14")
    Application.Calculation = xlCalculationManual
    dDiff1 = GetValue(rTarget, rVar, 0)
    lSign = Sgn((dDiff1 - Abs(GetValue(rTarget, rVar, 0.1))) * Sgn(dDiff1))
    For i = 0 To 15
        dDiff2 = GetValue(rTarget, rVar, lSign * 10 ^ i)
        If Abs(dDiff2) > Abs(dDiff1) Or Sgn(dDiff2) <> Sgn(dDiff1) Then Exit For
        k = i
        dDiff1 = dDiff2
    Next
    dVal = 0
    dDiff1 = dDiff1 * 2
    For i = k To -15 Step -1
        For j = 1 To 9
            dDiff2 = GetValue(rTarget, rVar, dVal + lSign * 10 ^ i)
            If Abs(dDiff2) > Abs(dDiff1) Then GoTo Next_i
            dVal = dVal + lSign * 10 ^ i
            If Sgn(dDiff2) <> Sgn(dDiff1) Then
                lSign = -lSign
                j = 9
            End If
            dDiff1 = dDiff2
        Next
Next_i:
    Next
    rVar.Value = dVal
    Application.Calculation = xlCalculationAutomatic
End Sub
Private Function GetValue(ByRef rTarget As Range, ByRef rVar As Range, ByVal dVal As Double) As Double
    rVar.Value = dVal
    rTarget.Parent.Calculate
    GetValue = rTarget.Value
End Function

Dạ vâng. Em cám ơn anh. Để em thử ạ

 

[songiang5011]

Bạn dùng thử code này:

Sub MySolve()
    Dim rVar As Range, rTarget As Range
    Dim lSign As Long, dDiff As Double, dDiff1 As Double, dDiff2 As Double, dVal As Double, dStep As Double
    Dim i As Long, j As Long, k As Long
    Set rVar = Sheet1.Range("M14")
    Set rTarget = Sheet1.Range("K14")
    Application.Calculation = xlCalculationManual
    dDiff1 = GetValue(rTarget, rVar, 0)
    lSign = Sgn((dDiff1 - Abs(GetValue(rTarget, rVar, 0.1))) * Sgn(dDiff1))
    For i = 0 To 15
        dDiff2 = GetValue(rTarget, rVar, lSign * 10 ^ i)
        If Abs(dDiff2) > Abs(dDiff1) Or Sgn(dDiff2) <> Sgn(dDiff1) Then Exit For
        k = i
        dDiff1 = dDiff2
    Next
    dVal = 0
    dDiff1 = dDiff1 * 2
    For i = k To -15 Step -1
        For j = 1 To 9
            dDiff2 = GetValue(rTarget, rVar, dVal + lSign * 10 ^ i)
            If Abs(dDiff2) > Abs(dDiff1) Then GoTo Next_i
            dVal = dVal + lSign * 10 ^ i
            If Sgn(dDiff2) <> Sgn(dDiff1) Then
                lSign = -lSign
                j = 9
            End If
            dDiff1 = dDiff2
        Next
Next_i:
    Next
    rVar.Value = dVal
    Application.Calculation = xlCalculationAutomatic
End Sub
Private Function GetValue(ByRef rTarget As Range, ByRef rVar As Range, ByVal dVal As Double) As Double
    rVar.Value = dVal
    rTarget.Parent.Calculate
    GetValue = rTarget.Value
End Function

Em cám ơn anh, code đúng ý em rồi ạ