SOLUTIONS C NG VBA FOR EXCEL K66

(Full code & commentary m i dòng kèm thuy t minh lý thuy t)

=====================================================================
V N 1 VÒNG L P & M NG
=====================================================================

---------------------------------------------------------------------
Bài 1 Hàm giai th a n!
---------------------------------------------------------------------
'-- Hàm dùng quy (lý thuy t: Recursion, i u ki n d ng).
Function Factorial(ByVal n As Long) As Long '-- Khai báo hàm, tr Long
If n = 0 Then '-- i u ki n d ng (base case)
Factorial = 1 '-- 0! = 1
Else '-- Nhánh quy
Factorial = n * Factorial(n - 1) '-- G i l i chính nó: n! = n·(n 1)!
End If '-- K t thúc m nh If Then Else
End Function '-- K t thúc hàm

---------------------------------------------------------------------
Bài 2 Phân tích s thành th a s nguyên t
---------------------------------------------------------------------
'-- Sub dùng vòng l p Do While & phép chia d Mod (thuy t: chia Euclid).
Sub PrimeFactors(ByVal N As Long)
Dim i As Long, s As String '-- Bi n i: c th ; s: k t qu chu i
i = 2 '-- B t u t c nguyên t nh nh t
Do While N > 1 '-- L p t i khi còn > 1
If N Mod i = 0 Then '-- i chia h t N ?
s = s & i & " * " '-- Ghép c vào chu i
N = N \ i '-- Chia nguyên (integer division) lo i b i
Else '-- N u không chia h t
i = i + 1 '-- T ng c th ( nh lý: m i h p s có c
N)
End If
Loop '-- K t thúc Do While
s = Left(s, Len(s) - 3) '-- Xoá ký t " * " th a cu i
Debug.Print s '-- In k t qu
End Sub

---------------------------------------------------------------------
Bài 3 c chung l n nh t (GCD) & b i chung nh nh t (LCM)
---------------------------------------------------------------------
'-- S d ng thu t toán Euclid (lý thuy t: chia h t, tính GCD).
Function GCD(ByVal a As Long, ByVal b As Long) As Long
Do While b <> 0
Dim r As Long: r = a Mod b '-- r = a mod b
a = b '-- Hoán i: a b
b = r '-- b ph n d r
Loop
GCD = a '-- K t qu cu i là GCD
End Function

Function LCM(ByVal a As Long, ByVal b As Long) As Long

LCM = a \ GCD(a, b) * b '-- nh ngh a: LCM = a·b / GCD
End Function

---------------------------------------------------------------------
Bài 4 S p x p t ng d n & Ki m tra dãy ã t ng
---------------------------------------------------------------------
Sub BubbleSort(arr As Variant)
Dim i As Long, j As Long, t
For i = LBound(arr) To UBound(arr) - 1 '-- Vòng For l p ngoài
For j = i + 1 To UBound(arr) '-- Vòng For l p trong
If arr(i) > arr(j) Then '-- So sánh hai ph n t
t = arr(i): arr(i) = arr(j): arr(j) = t '-- Hoán v (swap)
End If
Next j
Next i
End Sub

Function IsAscending(arr As Variant) As Boolean

Dim k As Long
For k = LBound(arr) + 1 To UBound(arr) '-- Duy t t ph n t th 2
If arr(k) < arr(k - 1) Then IsAscending = False: Exit Function
Next k
IsAscending = True
End Function

---------------------------------------------------------------------
Bài 5 Nhân hai ma tr n
---------------------------------------------------------------------
Function MatMul(A As Variant, B As Variant) As Variant '-- A(m×p) * B(p×n)
Dim m As Long, p As Long, n As Long, i As Long, j As Long, k As Long
m = UBound(A, 1): p = UBound(A, 2): n = UBound(B, 2)
Dim C(): ReDim C(1 To m, 1 To n) '-- Ma tr n k t qu m×n
For i = 1 To m
For j = 1 To n
For k = 1 To p '-- Công th c Cij = Aik·Bkj
C(i, j) = C(i, j) + A(i, k) * B(k, j)
Next k
Next j
Next i
MatMul = C
End Function

---------------------------------------------------------------------
Bài 6 B ng xo n c N×N (clockwise)
---------------------------------------------------------------------
Sub SpiralClockwise()
Dim N As Long: N = Sheets("input_bai1").Range("A1").Value
Dim x As Long, y As Long, stepMin As Long, stepMax As Long, val As Long
ReDim arr(1 To N, 1 To N)
stepMin = 1: stepMax = N
Do While stepMin <= stepMax
For y = stepMin To stepMax '-- Top hàng
val = val + 1: arr(stepMin, y) = val
Next y
For x = stepMin + 1 To stepMax '-- Right c t
val = val + 1: arr(x, stepMax) = val
Next x
For y = stepMax - 1 To stepMin Step -1 '-- Bottom hàng
val = val + 1: arr(stepMax, y) = val
Next y
For x = stepMax - 1 To stepMin + 1 Step -1 '-- Left c t
val = val + 1: arr(x, stepMin) = val
 Next x
stepMin = stepMin + 1: stepMax = stepMax - 1 '-- Thu h p vòng
Loop
Dim out As Worksheet: Set out = Sheets.Add(after:=Sheets(Sheets.Count))
out.Name = "output_bai1": out.Range("A1").Resize(N, N).Value = arr
End Sub

---------------------------------------------------------------------
Bài 7 B ng r n chéo (snake diagonal)
---------------------------------------------------------------------
'-- i n theo chéo ph , xen k h ng (lý thuy t: thao tác ch s ma tr n).
Sub SnakeDiagonal()
Dim N As Long: N = Sheets("input_bai2").Range("A1").Value
Dim i As Long, j As Long, v As Long, arr()
ReDim arr(1 To N, 1 To N)
For k = 2 To 2 * N '-- k = i+j (h ng s ng chéo)
If k Mod 2 = 0 Then '-- H ng xu ng
i = WorksheetFunction.Min(k - 1, N)
j = k - i
Do While i >= 1 And j <= N
v = v + 1: arr(i, j) = v
i = i - 1: j = j + 1
Loop
Else '-- H ng lên
j = WorksheetFunction.Min(k - 1, N)
i = k - j
Do While j >= 1 And i <= N
v = v + 1: arr(i, j) = v
i = i + 1: j = j - 1
Loop
End If
Next k
Sheets("output_bai2").Range("A1").Resize(N, N).Value = arr
End Sub

---------------------------------------------------------------------
Bài 8 Ma ph ng b c l (thu t toán Siam)
---------------------------------------------------------------------
Sub MagicSquareOdd()
Dim N As Long: N = 5 '-- Ví d N l
Dim r As Long, c As Long, k As Long, arr()
ReDim arr(1 To N, 1 To N)
r = 1: c = (N + 1) \ 2 '-- Quy t c 1: t 1 hàng 1 c t gi a
For k = 1 To N * N
arr(r, c) = k
Dim rNew As Long: rNew = r - 1
Dim cNew As Long: cNew = c + 1
If rNew < 1 Then rNew = N '-- Quy t c biên trên
If cNew > N Then cNew = 1 '-- Quy t c biên ph i
If arr(rNew, cNew) <> 0 Then '-- Ô ã i n ?
r = r + 1 '-- Di chuy n xu ng 1 hàng
Else
r = rNew: c = cNew '-- Di chuy n chéo lên ph i
End If
Next k
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "magic"
Sheets("magic").Range("A1").Resize(N, N).Value = arr
End Sub
=====================================================================
V N 2 X LÝ XÂU (STRING MANIPULATION)
=====================================================================

---------------------------------------------------------------------
Bài 1 c s ti n (<100 tri u) thành ch (ti ng Vi t gi n l c)
---------------------------------------------------------------------
'-- Ý t ng: chia ba kh i tri u-nghìn- n v , dùng m ng chu i M i/Hai m i
Sub NumberToWords()
Dim s As String: s = Application.WorksheetFunction.Text(Range("A1").Value, "0")
'-- Hàm tr : c t ng nhóm 3 ch s (Function ThreeDigitToWords)
'-- Ghép k t qu + h u t ng .
End Sub
'Chi ti t hàm ThreeDigitToWords c ghi y trong mã ngu n (xem PDF).

---------------------------------------------------------------------
Bài 2 Chu n hoá h tên
---------------------------------------------------------------------
Function NormalizeName(raw As String) As String
Dim parts As Variant, i As Long
raw = Application.WorksheetFunction.Trim(raw) '-- Xoá kho ng tr ng u/cu i & d gi a
raw = LCase(raw) '-- Chuy n v th ng
parts = Split(raw, " ")
For i = 0 To UBound(parts)
If parts(i) <> "" Then '-- B o v chu i r ng
parts(i) = UCase(Left(parts(i), 1)) & Mid(parts(i), 2)
End If
Next i
NormalizeName = Join(parts, " ")
End Function

---------------------------------------------------------------------
Bài 3 Tách h m & tên riêng
---------------------------------------------------------------------
Sub SplitName()
Dim full As String: full = Range("A2").Value
Dim idx As Long: idx = InStrRev(full, " ")
Range("B2").Value = Left(full, idx - 1) '-- H + m
Range("C2").Value = Mid(full, idx + 1) '-- Tên
End Sub

---------------------------------------------------------------------
Bài 4 Phép tr hai s r t l n l u d ng xâu
---------------------------------------------------------------------
Function BigSub(a As String, b As String) As String '-- Gi s |a| |b|
Dim i As Long, carry As Long, diff As Long, res As String
a = StrReverse(a): b = StrReverse(b) '-- o chu i thao tác t LSD
For i = 1 To Len(a)
diff = Val(Mid(a, i, 1)) - carry - IIf(i <= Len(b), Val(Mid(b, i, 1)), 0)
If diff < 0 Then diff = diff + 10: carry = 1 Else carry = 0
res = res & diff
Next i
res = StrReverse(res)
res = LTrim(res, "0") '-- Xoá s 0 vô ngh a u
If res = "" Then res = "0"
BigSub = res
End Function
=====================================================================
V N 3 QUY (RECURSION)
=====================================================================

---------------------------------------------------------------------
Bài 1 Sinh t t c t p con c a t p n ph n t
---------------------------------------------------------------------
Sub Subsets(n As Long)
Dim mark() As Boolean: ReDim mark(1 To n)
Call Gen(1, n, mark)
End Sub
Sub Gen(i As Long, n As Long, mark() As Boolean) '-- Hàm quy nh phân
If i > n Then
Dim k As Long, line$
= line
For k = 1 To n: If mark(k) Then line & k & " ": Next k
Debug.Print Trim(line$)
Else
mark(i) = False: Gen i + 1, n, mark '-- Nhánh không ch n
mark(i) = True: Gen i + 1, n, mark '-- Nhánh ch n
End If
End Sub

---------------------------------------------------------------------
Bài 2 Sinh hoán v (thu t toán i ch )
---------------------------------------------------------------------
Sub Permute(arr As Variant, l As Long, r As Long)
If l = r Then Debug.Print Join(arr, " ") Else
Dim i As Long
For i = l To r
Swap arr(l), arr(i)
Permute arr, l + 1, r
Swap arr(l), arr(i) '-- Back track
Next i
End If
End Sub
Sub Swap(ByRef x, ByRef y): Dim t: t = x: x = y: y = t: End Sub

---------------------------------------------------------------------
Bài 3 Giai th a quy ( ã có Bài 1 V n 1)

---------------------------------------------------------------------
Bài 4 Fibonaci quy có nh (memoization)
---------------------------------------------------------------------
Dim memo() As Variant
Function Fibo(n As Long) As Long
If n <= 1 Then Fibo = n: Exit Function
If IsEmpty(memo(n)) Then memo(n) = Fibo(n - 1) + Fibo(n - 2)
Fibo = memo(n)
End Function

=====================================================================
H NG D N GHI FILE EXCEL & T O SHEET
---------------------------------------------------------------------
'Sheets.Add after:=Sheets(Sheets.Count) '-- T o sheet cu i
'Sheets("Tên").Range("A1").Resize(N,N).Value = arr '-- m ng ra sheet
=====================================================================
( H t End of document )