Hơn 100 bài tập VBA có lời giải

tuhocvba

Administrator
Thành viên BQT
Bài 01:
Câu hỏi:
Viết chương trình tìm tất cả các số chia hết cho 7 nhưng không phải bội số của 5, nằm trong đoạn 2000 và 3200 (tính cả 2000 và 3200). Các số thu được sẽ được in thành chuỗi trên một dòng, cách nhau bằng dấu phẩy.

Yêu cầu: Có thể code trên Word hoặc Excel. Ghi kết quả ra vị trí tùy ý.
 

Mật vụ FBI

Yêu THVBA
PHP:
Sub THVBA()
    Dim i As Long
    Dim A As Double
    Dim B As Double
    Dim S As String
    
    S = ""
    
    For i = 2000 To 3200
        A = i Mod 7
        B = i Mod 5
        
        If A = 0 And B <> 0 Then
            If S = "" Then
                S = i
            Else
                S = S & "," & i
            End If
        End If
    Next i
    
End Sub
 

Mật vụ FBI

Yêu THVBA
PHP:
Function THVBA(No1 As Long, No2 As Long) As String
    Dim i As Long
    Dim A As Double
    Dim B As Double
    
  
    For i = No1 To No2
        A = i Mod 7
        B = i Mod 5
        
        If A = 0 And B <> 0 Then
            If THVBA = "" Then
                THVBA = i
            Else
                THVBA = THVBA & "," & i
            End If
        End If
    Next i
    
End Function
Function !
 

phuonghong1997

Yêu THVBA như điếu đổ
Mã:
Sub baitap1()
    Dim i   As Long
    Dim outs    As String
    Const n1 As Long = 2000
    Const n2 As Long = 3200
    outs = "@"
    For i = n1 To n2 Step 1
        If (i Mod 7 = 0) And (i Mod 5 <> 0) Then
            outs = outs & "," & CStr(i)
        End If
    Next i
    outs = Replace(outs, "@,", "", , , vbTextCompare)
outs = Replace(outs, "@", "", , , vbTextCompare)
    ThisWorkbook.Sheets(1).Cells(1, 1) = outs
End Sub
 

HUONGLIEN7214

Yêu THVBA
Bài 01:
Câu hỏi:
Viết chương trình tìm tất cả các số chia hết cho 7 nhưng không phải bội số của 5, nằm trong đoạn 2000 và 3200 (tính cả 2000 và 3200). Các số thu được sẽ được in thành chuỗi trên một dòng, cách nhau bằng dấu phẩy.

Yêu cầu: Có thể code trên Word hoặc Excel. Ghi kết quả ra vị trí tùy ý.
Góp vui bằng hàm UDF.
Mã:
Function ChiaHet(Tu As Long, Den As Long, k As Long)
Dim i&, j&
Dim s
    For i = Tu To Den
        If Mid(i, 3, 1) <> 0 Or Mid(i, 3, 1) <> 5 Then
            If i Mod k = 0 Then If s = Empty Then s = i Else s = s & ", " & i
        End If
    Next i
ChiaHet = s
End Function
Cú pháp = ChiaHet( so bắt đầu, số kết thúc, số chia)
= ChiaHet(2000,3200,7) và Enter
 
Mã:
Sub baitap1()
Dim s As String, arr As Variant, soluong As Integer
    For i = 2000 To 3200
        If (i Mod 7 = 0) And (i Mod 5 <> 0) Then
            s = s & "," & i
        End If
    Next
arr = Split(s, ",")
soluong = UBound(arr) - LBound(arr) + 1
MsgBox Right(s, Len(s) - 1) & vbCrLf & "Count: " & soluong
End Sub
 

Euler

Administrator
Thành viên BQT
Cảm ơn các bạn đã đưa ra các phương án giải. Do đã có lời giải nên chúng tôi không đưa ra đáp án nữa. Các thành viên lưu ý, trong topic này chỉ các Admin, Smod mới có quyền đưa ra bài toán để thảo luận.
Bài 02:
Câu hỏi:
Tiền kim loại của Việt Nam có các loại mệnh giá:
5000d
2000d
1000d
500d
200d
Một khách du lịch muốn đổi số tiền trị giá N đồng sang tiền kim loại để làm kỷ niệm. Du khách không muốn nhận quá M đồng xu tiền kim loại do ví của quý khách chỉ có sức chứa tối đa như vậy.
Input: N, M.
Output: Đưa ra số phương án đổi tiền thỏa mãn yêu cầu của khách.
Ví dụ : N = 2000, M = 3.
Khi đó sẽ có 3 phương án.
Phương án 1: 1 xu 2000
Phương án 2: 2 xu 1000
Phương án 3: 1 xu loại 1000, 2 xu loại 500.
Các phương án : 4 xu loại 500d sẽ không thỏa mãn vì khách chỉ nhận tối đa 3 đồng xu. Hoặc 3 xu 500d và một tờ tiền giấy 500d không được coi là thỏa mãn vì ta coi các tiền giấy nhỏ hơn hoặc bằng 5000d là không hợp lệ.
 

NhanSu

SMod
Thành viên BQT
Mình thử làm bài này, code sẽ chạy tốn nhiều thời gian nếu N và M lớn.
Gọi x, y, z, t, u là số lượng các xu 200, 500, 1000, 2000, 5000.
Code lặp với z, t, u là số lượng 3 loại xu lớn nhất. Khi có z, t, u rồi sẽ tính được số lượng cặp x, y (khai báo biến x, y ở đây thừa).
Code này còn có thể tăng tốc độ bằng cách loại bỏ một số vòng lặp thừa, mình sẽ post sau.
Mã:
Function DoiTien&(N&, M&)
    Dim x&, y&, z&, t&, u&, p&, q&, m1&, n1&, m2&, n2&, m3&, n3&
    If N Mod 100 > 0 Then
        DoiTien = 0
        Exit Function
    End If
    N = N \ 100
    For u = 0 To Application.Min(N \ 50, M)
        n1 = N - 50 * u
        m1 = M - u
   
        For t = 0 To Application.Min(n1 \ 20, m1)
            n2 = n1 - 20 * t
            m2 = m1 - t
       
            For z = 0 To Application.Min(n2 \ 10, m2)
                n3 = n2 - 10 * z
                m3 = m2 - z
           
                If (n3 - 2 * m3) Mod 3 = 0 Then
                    p = Application.Max(Int((n3 - 2 * m3) / 3), n3 Mod 2)
                Else
                    p = Application.Max(Int((n3 - 2 * m3) / 3) + 1, n3 Mod 2)
                End If
           
                q = Application.Min(n3 \ 5, m3)
           
                If p <= q Then
                    If (q - p) Mod 2 = 1 Then
                        count = count + (q - p + 1) \ 2
                    ElseIf (p - n3) Mod 2 = 0 Then
                        count = count + (q - p) \ 2 + 1
                    Else
                        count = count + (q - p) \ 2
                    End If
                End If
            Next
        Next
    Next
    DoiTien = count
End Function
Sub test()
    Debug.Print DoiTien(1000000, 500)
End Sub
 
Sửa lần cuối:

PTHhn

Yêu THVBA như điếu đổ
Em chạy đầu vào 10000, 2.
Mà nó bảo hàm Min của bác chưa được định nghĩa.
Office 365 32bit, Win 10 64bit.
 

NhanSu

SMod
Thành viên BQT
Cảm ơn bạn, mình bị thiếu Application ở dòng 26, code đã sửa từ Min thành Application.Min ở bài 7.
 

PTHhn

Yêu THVBA như điếu đổ
Dạ chạy được rồi. Nhưng mà nếu cán bộ không giải thích gì thêm thì em không hiểu ý tưởng cán bộ là như thế nào cán bộ ạ.
 

NhanSu

SMod
Thành viên BQT
Đây là code của mình sau khi đã tăng tốc, với N=1000000, M=500 thì code bài 7 chạy rất lâu, mình không chờ được nên phải Ctrl-Break để bỏ qua. Với code dưới thì chạy được trong 30s (giải thích code thì đến tối mình sẽ làm, giờ chưa làm được)
Mã:
Function DoiTien&(N&, M&)
    Dim x&, y&, z&, t&, u&, p&, q&, m1&, n1&, m2&, n2&, m3&, n3&, count&
    If N Mod 100 > 0 Then
        DoiTien = 0
        Exit Function
    End If
    N = N \ 100
   
    If 50 * M < N Then
        DoiTien = 0
        Exit Function
    End If
   
    For u = 0 To Application.Min(N \ 50, M)
        n1 = N - 50 * u
        m1 = M - u
       
        If 20 * m1 < n1 Then Exit For
        For t = 0 To Application.Min(n1 \ 20, m1)
            n2 = n1 - 20 * t
            m2 = m1 - t
           
            If 10 * m2 < n2 Then Exit For
            For z = 0 To Application.Min(n2 \ 10, m2)
                n3 = n2 - 10 * z
                m3 = m2 - z
                If m3 >= 2 Then
                    If (n3 - 2 * m3) Mod 3 = 0 Then
                        p = Application.Max(Int((n3 - 2 * m3) / 3), n3 Mod 2)
                    Else
                        p = Application.Max(Int((n3 - 2 * m3) / 3) + 1, n3 Mod 2)
                    End If
               
                    q = Application.Min(n3 \ 5, m3)
               
                    If p <= q Then
                        If (q - p) Mod 2 = 1 Then
                            count = count + (q - p + 1) \ 2
                        ElseIf (p - n3) Mod 2 = 0 Then
                            count = count + (q - p) \ 2 + 1
                        Else
                            count = count + (q - p) \ 2
                        End If
                    End If
                ElseIf m3 = 1 And (n3 = 2 Or n3 = 5 or n3 = 0) Then
                    count = count + 1
                ElseIf m3 = 0 And n3 = 0 Then
                    count = count + 1
                End If
            Next
        Next
    Next
    DoiTien = count
End Function
Sub test()
    Dim x
    x = Timer
    Debug.Print DoiTien(1000000, 500)
    Debug.Print Timer - x
End Sub
 
Sửa lần cuối:

Euler

Administrator
Thành viên BQT
Hướng đi ở do là đúng rồi.
Bài toán sẽ phức tạp hơn nếu phải xử lý cả tiền giấy. Chẳng hạn với 1 triệu đồng, muốn đổi ra tiền giấy và tiền xu trong đó số lượng tiền xu không vượt quá 5 đồng. Khi đó phải liệt kê loại tiền giấy, vòng lặp sẽ mệt mỏi hơn. Do đó chấp nhận hướng giải quyết ở trên, tức là chỉ quan tâm tới tiền xu mà thôi.
Lời giải code ở trên của NhanSu có thể gây khó đọc cho một số bạn nên mình giải thích:
Các loại tiền 5000, 2000, 1000, 500, 200 đều chia hết cho 100. Do đó để tránh làm việc với số lớn, ta chia tất cả dữ kiện về tiền cho 100.
Như vậy số tiền xu quy ước thành 50, 20, 10, 5,2 và số tiền là N2 = N/100.
Lời giải ở trên là thực hiện liên tiếp các phép thử.
Số tiền 50 là từ 0 tới N2. Nhưng nếu N2 >M thì chỉ thử tới M.
Với mỗi đồng 50 trong phép thử thì số tiền còn lại được định nghĩa lại: N2i = N2 - 50*i
Và số tiền xu được thắt chặt lại còn Mi = M-i
Tương tự như thế cho các đồng tiền khác.
Cho tới đồng tiền cuối cùng là 2 thì không cần dùng vòng lặp For nữa, ta thử xem số tiền còn lại có là số chia hết cho 2 hay không.

Đây là bài toán cơ bản luyện tập nhiều vòng lặp For lồng vào nhau.
\[ \left\{\begin{matrix} 50a+20b+10c+5d+2e& =N_2\\ a+b+c+d+e & \leq M \end{matrix}\right. \]
Trong đó a,b,c,d,e là các số nguyên không âm.
 
Top