Xin lời khuyên VBA

Liên hệ QC

sadmore

Thành viên mới
Tham gia
1/3/19
Bài viết
5
Được thích
0
Em có 1 bài toán như thế này xin các đại cao thủ VBA giúp đỡ e với ạ. . 54257035_330697660885628_5633933362096766976_n.pngĐây là yêu cầu bài toán . Điền vào các giá trị trong ô trống sao cho thỏa với các điều kiện hàng và cột. vd: tại cột B1. ô đầu tiên bằngB1= 1, 4 ô(b2+b3+b4+b5) sau nó điền làm sao cho tổng bằng 1. Tương tự như hàng cũng làm như thế với hàng A2.Xin anh chị giúp e với ạ
 

File đính kèm

  • Đồ án fgiữa kỳ.xlsm
    21.7 KB · Đọc: 7
  • 53889035_687605731642066_7676630631391952896_n.png
    53889035_687605731642066_7676630631391952896_n.png
    1.8 KB · Đọc: 14
quá đơn giản dùm hàm Sum và Ham And, Or, Not, Count, Max, Min..... là ra ấy mà
 
Em có 1 bài toán như thế này xin các đại cao thủ VBA giúp đỡ e với ạ. . View attachment 213484Đây là yêu cầu bài toán . Điền vào các giá trị trong ô trống sao cho thỏa với các điều kiện hàng và cột. vd: tại cột B1. ô đầu tiên bằngB1= 1, 4 ô(b2+b3+b4+b5) sau nó điền làm sao cho tổng bằng 1. Tương tự như hàng cũng làm như thế với hàng A2.Xin anh chị giúp e với ạ
Giá trị điền vào ô trống có giới hạn hay là không
 
Giá trị điền vào ô trống có giới hạn hay là không
miễn sao là phù hợp với điều kiện thôi. giới là 16 ô đó thôi. xin giúp với ạ
Bài đã được tự động gộp:

quá đơn giản dùm hàm Sum và Ham And, Or, Not, Count, Max, Min..... là ra ấy mà
e có thử rất nhiều cách rồi. giờ đang nghiên cứu đệ quy. xin a chỉ e e với ạ
 
Bạn đăng vào mục "Hàm và công thức Excel" nhưng lại đặt tiêu đề lại là "Xin lời khuyên VBA"
Lời khuyên VBA: VBA thì đăng vào nơi của VBA.

Về bài toán:
Bài toán này có vô số nghiệm, bạn dùng công thức sau để có kết quả đầu tiên:
Mã:
=MIN(B$1*2-SUM(B$1:B1),$A2*2-SUM($A2:A2))
Từ 1 kết quả, chọn một ma trận vuông con bất kỳ, điều chỉnh 2 số ở hai góc trên đường chéo chính một số -a và điều chỉnh 2 số ở hai góc trên đường chéo phụ một số a sẽ được kết quả khác.
 
Bạn đăng vào mục "Hàm và công thức Excel" nhưng lại đặt tiêu đề lại là "Xin lời khuyên VBA"
Lời khuyên VBA: VBA thì đăng vào nơi của VBA.

Về bài toán:
Bài toán này có vô số nghiệm, bạn dùng công thức sau để có kết quả đầu tiên:
Mã:
=MIN(B$1*2-SUM(B$1:B1),$A2*2-SUM($A2:A2))
Từ 1 kết quả, chọn một ma trận vuông con bất kỳ, điều chỉnh 2 số ở hai góc trên đường chéo chính một số -a và điều chỉnh 2 số ở hai góc trên đường chéo phụ một số a sẽ được kết quả khác.
dạ e xin lỗi ạ. e lần đầu đăng bài xin thông cảm
 
Cốt ý người ta lấy bài giải ở đây và đem qua bên kia đố.
Bạn làm lộ tẩy của người ta rồi. Sao mà ác thế.
là e luôn đó a . tại vì nãy a kia bài này k được đăng bên kia . nên e chuyển qua đây
Bài đã được tự động gộp:

Cốt ý người ta lấy bài giải ở đây và đem qua bên kia đố.
Bạn làm lộ tẩy của người ta rồi. Sao mà ác thế.
vâng e xin lỗi mọi người. tại lần đầu đăng bài nên đăng không đúng chỗ nên e rút kinh nghiệm lần này. mong mọi người thông cảm
 
miễn sao là phù hợp với điều kiện thôi. giới là 16 ô đó thôi. xin giúp với ạ
Bài đã được tự động gộp:


e có thử rất nhiều cách rồi. giờ đang nghiên cứu đệ quy. xin a chỉ e e với ạ
Nếu không giới hạn max, min các số trong 16 ô thì có lẽ kết quả là vô hạn.
Bài này code thử với giới hạn >=0 & <=4, bạn test thử xem sao
Bạn chèn thêm sheet2 rồi hẵng chạy code
Mã:
Option Explicit
Dim MangMau
Dim Kq

Sub vba_abv()
Dim TongNgang
Dim TongDoc
Dim Dong, Cot, MangTT
Dim MauCh
Dim MauNgang
Dim Tam
Dim i, j, k, x, z, t, Tm
Tm = Timer
With Sheet1
    TongNgang = .Range("a2:a5")
    TongDoc = .Range("b1:e1")
    Dong = UBound(TongNgang)
    Cot = UBound(TongDoc, 2)

    k = 5
End With
Sheet2.UsedRange.Clear
ReDim MangMau(1 To k ^ Cot, 1 To 1)
ReDim MauCh(Cot - 1)
Call CHP(ByVal 0, ByVal Cot, ByVal MauCh, ByVal 0, Cot, 0)
ReDim MauNgang(1 To Dong, 1 To 1)
For i = 1 To Dong
    ReDim Tam(UBound(MangMau))
    t = 0
    For Each x In MangMau
        k = 0
        For Each j In x
            k = k + j
        Next j
        If k = TongNgang(i, 1) Then
            Tam(t) = x
            t = t + 1
        End If
    Next x
    ReDim Preserve Tam(t - 1)
    MauNgang(i, 1) = Tam
Next i
ReDim MangTT(1 To Dong, 1 To Cot)
Call Test(TongDoc, ByVal MangTT, MauNgang, ByVal 1)
Sheet2.Range("a1") = Timer - Tm
Beep
End Sub

Sub CHP(ByVal Dau, ByVal Cuoi, ByVal Mang, ByVal Chap, Spt, r)
Dim i
If Chap = Spt Then
    r = r + 1
    MangMau(r, 1) = Mang
Else
    For i = Dau To Cuoi
        Mang(Chap) = i
        Call CHP(ByVal Dau, ByVal Cuoi, ByVal Mang, ByVal Chap + 1, Spt, r)
    Next i
End If
End Sub

Sub Test(Doc, ByVal Mang, MCHP, ByVal r)
Dim MCon
Dim i, j, k, n, d
If r = UBound(Mang) + 1 Then
    For j = 1 To UBound(Mang, 2)
        k = 0
        For i = 1 To UBound(Mang)
            k = k + Mang(i, j)
        Next i
        If k = Doc(1, j) Then
            d = d + 1
        Else
            Exit For
        End If
    Next j
    If d = UBound(Mang, 2) Then
        Sheet2.Range("a1000000").End(xlUp).Offset(2).Resize(UBound(Mang), UBound(Mang, 2)) = Mang
        Sheet2.Range("a1000000").End(xlUp).Select
    End If
Else
    For Each MCon In MCHP(r, 1)
        For j = 1 To UBound(Mang, 2)
            Mang(r, j) = MCon(j - 1)
        Next j
        Call Test(Doc, ByVal Mang, MCHP, ByVal r + 1)
    Next MCon
End If
End Sub
 
Nếu không giới hạn max, min các số trong 16 ô thì có lẽ kết quả là vô hạn.
Bài này code thử với giới hạn >=0 & <=4, bạn test thử xem sao
Bạn chèn thêm sheet2 rồi hẵng chạy code
Mã:
Option Explicit
Dim MangMau
Dim Kq

Sub vba_abv()
Dim TongNgang
Dim TongDoc
Dim Dong, Cot, MangTT
Dim MauCh
Dim MauNgang
Dim Tam
Dim i, j, k, x, z, t, Tm
Tm = Timer
With Sheet1
    TongNgang = .Range("a2:a5")
    TongDoc = .Range("b1:e1")
    Dong = UBound(TongNgang)
    Cot = UBound(TongDoc, 2)

    k = 5
End With
Sheet2.UsedRange.Clear
ReDim MangMau(1 To k ^ Cot, 1 To 1)
ReDim MauCh(Cot - 1)
Call CHP(ByVal 0, ByVal Cot, ByVal MauCh, ByVal 0, Cot, 0)
ReDim MauNgang(1 To Dong, 1 To 1)
For i = 1 To Dong
    ReDim Tam(UBound(MangMau))
    t = 0
    For Each x In MangMau
        k = 0
        For Each j In x
            k = k + j
        Next j
        If k = TongNgang(i, 1) Then
            Tam(t) = x
            t = t + 1
        End If
    Next x
    ReDim Preserve Tam(t - 1)
    MauNgang(i, 1) = Tam
Next i
ReDim MangTT(1 To Dong, 1 To Cot)
Call Test(TongDoc, ByVal MangTT, MauNgang, ByVal 1)
Sheet2.Range("a1") = Timer - Tm
Beep
End Sub

Sub CHP(ByVal Dau, ByVal Cuoi, ByVal Mang, ByVal Chap, Spt, r)
Dim i
If Chap = Spt Then
    r = r + 1
    MangMau(r, 1) = Mang
Else
    For i = Dau To Cuoi
        Mang(Chap) = i
        Call CHP(ByVal Dau, ByVal Cuoi, ByVal Mang, ByVal Chap + 1, Spt, r)
    Next i
End If
End Sub

Sub Test(Doc, ByVal Mang, MCHP, ByVal r)
Dim MCon
Dim i, j, k, n, d
If r = UBound(Mang) + 1 Then
    For j = 1 To UBound(Mang, 2)
        k = 0
        For i = 1 To UBound(Mang)
            k = k + Mang(i, j)
        Next i
        If k = Doc(1, j) Then
            d = d + 1
        Else
            Exit For
        End If
    Next j
    If d = UBound(Mang, 2) Then
        Sheet2.Range("a1000000").End(xlUp).Offset(2).Resize(UBound(Mang), UBound(Mang, 2)) = Mang
        Sheet2.Range("a1000000").End(xlUp).Select
    End If
Else
    For Each MCon In MCHP(r, 1)
        For j = 1 To UBound(Mang, 2)
            Mang(r, j) = MCon(j - 1)
        Next j
        Call Test(Doc, ByVal Mang, MCHP, ByVal r + 1)
    Next MCon
End If
End Sub
dạ code của a e thử như thế là đúng rồi. rất tuyệt vời nhưng do trình độ e còn mới bắt đầu nên đọc code hơi khó 1 tí. a cho e hỏi là chỉ muốn lấy 1 kết quả thì e nên sửa thế nào
 
dạ code của a e thử như thế là đúng rồi. rất tuyệt vời nhưng do trình độ e còn mới bắt đầu nên đọc code hơi khó 1 tí. a cho e hỏi là chỉ muốn lấy 1 kết quả thì e nên sửa thế nào
Chỗ mấy dòng sheet2…, bạn sửa thành lưu vào mảng nào đó, rồi sau muốn lấy ra 1 hay mấy thì tùy.
 
Web KT
Back
Top Bottom