Bài tập VBA - Macro

Liên hệ QC
Đã nói rồi, bài này mình chẳng có cơ bản nên code chủ yếu là hưởng ứng các ngày lễ lớn trong năm thôi.
 
Nếu áp dụng thuật toán của tôi thì phải đến phần nguyên của cll/2. Ví dụ với số 81 mà xét i=1 đến 9 thì tèo luôn.
81 thì lại chỉ cần xét đến 3 là ngưng rồi. Còn Phi nói chỉ xét đến căn bậc 2 là đúng. Thêm 1 ý là xét tối đa đến căn bậc 2.
 
Mã:
Function KTNT(n As Long) As Boolean
    ' Chi xet cac so duong thoi
 Dim Tam As Boolean
 Dim i As Long
    If (n = 1) Then
         KTNT = False
        Exit Function
    End If
  
    If (n > 1 And n < 4) Then
        KTNT = True
        Exit Function
    End If
    Tam = True
    For i = 2 To Sqr(n)
        If (n Mod i = 0) Then
              Tam = False
              Exit For
         End If
     Next
    KTNT = Tam
End Function

Mã:
Sub GPE()
Dim Arr()
Dim Max_NT As Long
Dim DS_NT As String
Dim Tam As Long
       
       DS_NT = "   "
       Arr = Range("A1:H8")
       Max_NT = 0
       For i = 1 To 8
        For j = 1 To 8
            Tam = Arr(i, j)
            If (KTNT(Tam) = True) Then
                DS_NT = DS_NT & Tam & "   "
                If (Tam > Max_NT) Then
                    Max_NT = Tam
                End If
            End If
         Next j
    Next i
   If (Max_NT > 0) Then
    MsgBox "So nguyen to lon nhat" & Max_NT
   Else
    MsgBox " khong co So nguyen to lon nhat"
   End If
  MsgBox DS_NT
    
End Sub

Function KTNT là kiểm tra tính nguyên tố của một số
Sub GPE là duyệt qua các phần tử của mảng để biết số nào là số nguyên tố và tìm xem số nguyên tố lớn nhất

Bài tập
có thể viết Function KTNT theo hướng đệ quy?
 
Lần chỉnh sửa cuối:
-------------------------------------------------------------------------------
Function KTNT là kiểm tra tính nguyên tố của một số
Sub GPE là duyệt qua các phần tử của mảng để biết số nào là số nguyên tố và tìm xem số nguyên tố lớn nhất

Bài tập
có thể viết Function KTNT theo hướng đệ quy?
Thuật toán thì có nhiều, nhưng chọn thuật toán nào tối ưu nhất mới là vấn đề! !$@!!!$@!!!$@!!
--------------------------------------------------------------------------------------------------------------------------------
Mấy thuật toán này ngày xưa học pascal thì cũng biết sơ qua vì ngày đó học tin có biết để làm gì đâu nên giờ quên sạch. Giờ tự ngồi nghĩ hướng giải quyết để nâng cao khả năng tư duy+-+-+-++-+-+-++-+-+-+
 
có thể viết Function KTNT theo hướng đệ quy?
Mời các thành viên tham gia viết code để học hỏi thêm và ôn luyện cách viết code, "Nhất là các bạn nào mới tiếp xúc VBA xem như đây là các vấn đề mình cần giải quyết"
Yêu cầu có thể viết một Function kiểm tra tính nguyên tố của 1 số bằng phương pháp đệ quy?
 
Mời các thành viên tham gia viết code để học hỏi thêm và ôn luyện cách viết code, "Nhất là các bạn nào mới tiếp xúc VBA xem như đây là các vấn đề mình cần giải quyết"
Yêu cầu có thể viết một Function kiểm tra tính nguyên tố của 1 số bằng phương pháp đệ quy?
Không rõ đây là câu hỏi hay là đề bài vậy bạn?
------------------------------------------------------------
Với bài toán tính giai thừa thì hàm đệ quy viết đơn giản thế này, nhưng với bài toán kiểm tra số nguyên tố thì không biết có viết được bằng đệ quy không nữa. Tôi nghĩ là không viết được.
Mã:
Public Function gt(n) As Double
Dim i As Long
If n = 0 Then
    gt = 1
Else
    gt = n * gt(n - 1)
End If
End Function
 
Lần chỉnh sửa cuối:
Tôi cũng loay hoay 1 lúc nhưng chưa nghĩ ra được thuật toán. Mong được học hỏi!
Cứ từ từ, tôi thấy tất cả các code bạn viết. Bạn ít có vận dụng function để chia nhỏ vấn đề ra để quản lý. Mà cái đó cực kỳ linh hoạt trong việc code kiết. Bài giai thừa của bạn tất cả là kiểu long sao giá trị trả về là double?
 
Cứ từ từ, tôi thấy tất cả các code bạn viết. Bạn ít có vận dụng function để chia nhỏ vấn đề ra để quản lý. Mà cái đó cực kỳ linh hoạt trong việc code kiết. Bài giai thừa của bạn tất cả là kiểu long sao giá trị trả về là double?
Thực ra kĩ thuật lập trình và kiến thức cơ bản là những cái tôi rất yếu(Tôi không được học cơ bản), mong được học hỏi nhiều từ bạn và các thành viên khác.
 
Mời các thành viên mới đang học VBA tham gia đề tài cho sum tụ. Cùng nhau tiến bộ
 
Mời các thành viên tham gia viết code để học hỏi thêm và ôn luyện cách viết code, "Nhất là các bạn nào mới tiếp xúc VBA xem như đây là các vấn đề mình cần giải quyết"
Yêu cầu có thể viết một Function kiểm tra tính nguyên tố của 1 số bằng phương pháp đệ quy?

code đệ quy kiểm tra tính nguyên tố của một số

Mã:
Function KTNT(n As Long, dau As Long, cuoi As Long) As Boolean
    If (n = 1) Then
        KTNT = False
        Exit Function
     End If
     
    If (cuoi < dau) Then
        KTNT = True
        Exit Function
     End If
     If (n Mod dau = 0) Then
        KTNT = False
        Exit Function
     End If
     KTNT = KTNT(n, dau + 1, cuoi)
End Function

code chính lấy ra những số đúng là số nguyên tố

Mã:
Sub GPE()
Dim Arr()
Dim Max_NT As Long
Dim DS_NT As String
Dim Tam As Long
       
       DS_NT = "   "
       Arr = Range("A1:H8")
       Max_NT = 0
       For i = 1 To 8
        For j = 1 To 8
            Tam = Arr(i, j)
            If (KTNT(Tam, 2, Sqr(Tam)) = True) Then
                DS_NT = DS_NT & Tam & "   "
                If (Tam > Max_NT) Then
                    Max_NT = Tam
                End If
            End If
         Next j
    Next i
   If (Max_NT > 0) Then
    MsgBox "So nguyen to lon nhat" & Max_NT
   Else
    MsgBox " khong co So nguyen to lon nhat"
   End If
  MsgBox DS_NT
    
End Sub
 
Mời các thành viên mới đang học VBA tham gia đề tài cho sum tụ. Cùng nhau tiến bộ
Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.
Mã:
Function NT(ByVal p&, ByVal q&) As Boolean
    If q < 2 Then
        NT = True
        Exit Function
    End If
    If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2)
End Function
Function KTNT(ByVal p&) As Boolean
    If p < 2 Then
        KTNT = False
    ElseIf p < 4 Then
        KTNT = True
    ElseIf p Mod 2 = 0 Then
        KTNT = False
    Else
        KTNT = NT(p, Int(Sqr(p)))
    End If
End Function
 
Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.
Mã:
Function NT(ByVal p&, ByVal q&) As Boolean
    If q < 2 Then
        NT = True
        Exit Function
    End If
    If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2)
End Function
Function KTNT(ByVal p&) As Boolean
    If p < 2 Then
        KTNT = False
    ElseIf p < 4 Then
        KTNT = True
    ElseIf p Mod 2 = 0 Then
        KTNT = False
    Else
        KTNT = NT(p, Int(Sqr(p)))
    End If
End Function
Thực sự là viết đệ quy là để học thuật toán này thôi chứ bài này dùng đệ quy đúng là phức tạp. Với bài toán "Tháp cổ Hà Nội" thì dùng đệ quy thì hợp lí hơn. Bài này vòng lập dễ hiểu hơn!
 
Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.
Mã:
Function NT(ByVal p&, ByVal q&) As Boolean
    If q < 2 Then
        NT = True
        Exit Function
    End If
    If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2)
End Function
Function KTNT(ByVal p&) As Boolean
    If p < 2 Then
        KTNT = False
    ElseIf p < 4 Then
        KTNT = True
    ElseIf p Mod 2 = 0 Then
        KTNT = False
    Else
        KTNT = NT(p, Int(Sqr(p)))
    End If
End Function
Thuật toán của anh hay đấy chứ (Áp dụng sặc mùi toán học luôn hihi). sao lại nghĩ là chơi vui, đúng là dùng vòng lặp dễ còn hiệu quả hơn thì hên suôi( tùy vào trường hợp nào mà ta áp dụng cái nào cho hiệu quả). Ở đây là mục bài tập nên mình chỉ bàn đến các giải thuật để giải quyết vấn đề sau đó cảm thấy cái nào hay thì mình học hỏi vậy thôi
 
Lần chỉnh sửa cuối:
Bài tiếp theo dễ hơn bài trước nhiều, các thành viên mới nên tham gia để học hỏi tư duy:
Yêu cầu chuyển 1 số từ hệ thập phân sang hệ nhị phân? (nếu có thể thì làm bằng vòng lặp và đệ quy luôn)
ví dụ N= 15 thì kết quả mong muốn là 1111
ví dụ N= 10 thì kết quả mong muốn là 1010
chúc các bạn ngày mới vui vẻ
 
Bài này dùng đệ quy cho đỡ phải viết nhiều. Mình online bằng điện thoại, test sau.
Mã:
Function DecimalToBinary(Byval n&) As String
   If n<2 Then
       DecimalToBinary=CStr(n)
    Else
        DecimalToBinary=DecimalToBinary(Int(n/2)) & (n Mod 2)
   End If
End Function
 
Web KT
Back
Top Bottom