Bài tập cho người dùng VBA

[SA_DQ]

Trong hình là 1 trang tính có chứa 3 vùng (tạm gọi là Khóa, Chia 1 & Chia 2)
Vùng Chìa 1 có chứa các từ TRUONG SA
Vùng chìa 2 tương tự là DONG TRIEU

Bài tập đề ra là viết macro để biến đoạn "KHONG CO . . . ."
Mã hóa thành "BOFEA UF . . . . " bên dưới
Chúc các bạn thành công!
(Sau 3 ngày sẽ có đáp án Nếu chưa có bài giải)

 

[SA_DQ]

Đáp án #1:

Function MaHoa(StrC As String) As String
 Dim sRng As Range, dRng As Range, Cls As Range
 Dim J As Long:             Dim Tmp As String

 Set sRng = [B2:G7].CurrentRegion
 Set dRng = [C11].CurrentRegion
 MsgBox sRng.Address
 For J = 1 To Len(StrC)
    Tmp = Mid(StrC, J, 1)
    If Tmp = " " Then
        MaHoa = MaHoa & Tmp
    Else
        Set Cls = sRng.Find(Tmp, , xlFormulas, xlWhole)
        If Not Cls Is Nothing Then
            MaHoa = MaHoa & Cells(Cls.Row + 8, Cls.Column).Value
        Else
        End If
    End If
 Next J
End Function

 

[SA_DQ]

Bài tập thứ 2:

Cách mã hóa 1 đoạn văn bản như #1 sẽ không dễ bẽ khóa với chúng ta;
Nhưng với những chuyên gia về mật mã thì không gì là không thể
Để gây thêm khó khắn cho các chuyên gia, ta có thể dùng ống khóa kép
Chuyện này liên tưởng đến hai gia đình cùng có 1 cánh cổng
Tóm lại là ta có thể mã hóa đoạn văn bản độ dài 33 kí tự thành đoạn mã có trên 33 x 2 ký tự
(Như hình bài 1 đang là 67 ký tự kể cả khoảng trắng)
Nội dung BT2: Viết 1 hàm để mã hóa 1 đoạn văn bản (có độ dài 33 kí tự) thành đoạn mã trên 66 ký tự thông qua 2 chìa "TRUONG SA" & "DONG TRIEU" cùng đọc & dịch được nội dung

Mong các bạn sẽ có lời giải sau 50 giờ kể từ lúc đăng bài này!

 

[SA_DQ]

& đây là bài giải:

Function MaHoa2(StrC As String) As String
 Dim Rg0 As Range, Cls As Range
 Dim J As Long, Tmp As String
 Dim Ma1 As String, Ma2 As String
 
 Set Rg0 = [B2:G7].CurrentRegion
 Randomize
 For J = 1 To Len(StrC)
    Tmp = Mid(StrC, J, 1)
    If Tmp = " " Then
        MaHoa2 = MaHoa2 & Space(1 + 2 * Rnd \ 1)
    Else
        Set Cls = Rg0.Find(Tmp, , xlFormulas, xlWhole)
        If Not Cls Is Nothing Then
            MaHoa2 = MaHoa2 & Cells(Cls.Row + 8, Cls.Column).Value
            MaHoa2 = MaHoa2 & Cells(Cls.Row + 16, Cls.Column).Value
        End If
    End If
 Next J
End Function

Kết quả của hàm sẽ là :

BA0IFHEFAR UNFH AR1E IKMQWX 0IFHEF OGFHUN CBTDHJ LPMQ OGFH

 

[SA_DQ]

Xin gởi tới các bạn file tham khảo về cách tổng kết các quỹ của cơ quan hàng tháng
File thực hiện bỡi VBA

 

[SA_DQ]

BÀI TẬP VỀ 6 SỐ KHÁC NHAU GHÉP THÀNH 1 SỐ​

Chúng ta có bảng số liệu sau đây:

ABCDEF		A	B	C	D	E	F		Tổng	39​
123450​		1	2	3	4	5	0		15​
987654​		9	8	7	6	5	4		39​

Trong đó A,B,C,D.E & F là 6 ký số hoàn toàn khác nhauỞ cột 'Tổng' sẽ ghi tổng các ký số của mỗi số bất kỳ;
Chúng ta sẽ có tổng bé nhất sẽ là 15 & tổng lớn nhất sẽ là 39
Macro dưới đây sẽ liệt kê 100 số ghép đó thỏa điều kiện có tổng là 39; Ngoài ra macro này cho phép ta biết số lượng các số ghép từ 6 số có tổng là 39:

Sub Tong6KiSo_()
 Dim J1 As Integer, J2 As Integer, J3 As Integer, J4 As Integer, J5 As Integer, J6 As Integer, W As Long
 Dim Tong6   As Long, Tmp As Integer, Tong As Integer
 ReDim Arr(1 To 99, 1 To 1)

 On Error GoTo Thoat
 Tong = [K1].Value
 [K7].CurrentRegion.ClearContents
 Tmr = Timer()
 For J1 = 1 To 9
    For J2 = 0 To 9
        If J2 <> J1 Then
            For J3 = 0 To 9
                If J3 <> J2 And J3 <> J1 Then
                    For J4 = 0 To 9
                        If J4 <> J3 And J4 <> J2 And J4 <> J1 Then
                            For J5 = 0 To 9
                                If J5 <> J4 And J5 <> J3 And J5 <> J2 And J5 <> J1 Then
                                    For J6 = 0 To 9
                                        If J6 <> J1 And J6 <> J2 And J6 <> J3 And J6 <> J4 And J6 <> J5 Then
                                            Tong6 = J1 + J2 + J3 + J4 + J5 + J6
                                            If Tong6 = Tong Then
                                                W = W + 1:
                                                If W < 100 Then Arr(W, 1) = J1 & J2 & J3 & J4 & J5 & J6             '
                                            End If
                                        End If
                                    Next J6
                                End If
                            Next J5
                        End If
                    Next J4
                End If
            Next J3
        End If
    Next J2
 Next J1
 MsgBox W, , Tong
Thoat:
 [K5].Resize(100).Value = Arr()
End Sub

 

[SA_DQ]

CẢNH BÁO SẮP ĐẾN NGÀY SINH NHẬT CỦA CÁC THƯỢNG ĐẾ.​

Giả dụ chúng ta có 1 danh sách các kha81ch hàng thân thiết như bảng sau:

STT

Mã KH

Họ & Tên

Ngày sinh

ĐT

MST

ĐC

1

BXT00

Bùi Xuân Thắm

02/27/1977​

1​

2

BXT01

Bùi Thị Xuân Thành

02/28/1978​

3​

3

CCH00

Châu Chấn Huy

03/01/1979​

5​

4

CJL00

Cù Lân

03/02/1980​

1​

5

CMN00

Công Tằng Tôn Nữ Minh Nguyệt

03/03/1981​

3​

6

CNM00

Công Tằng Tôn Nữ Nguyệt Minh

03/04/1982​

5​

7

CNS00

Chu Ngọc Sơn

03/05/1983​

7​

8

CVA00

Cỗ Văn Ẩn

03/06/1984​

3​

9

DAH00

Dương Ánh Hòa

03/07/1985​

5​

10

FFD00

Đào Đức Dương

03/08/1986​

7​

11

FFD01

Đỗ Đăng Dung

03/09/1987​

2​

12

FLT00

Đinh La Thăng

03/10/1988​

5​

13

LCM00

Lê Công Minh

03/11/1989​

7​

14

LCM01

Lã Chí Mai

03/12/1990​

2​

15

LCT00

Lê Công Thành

03/13/1991​

4​

16

LTH00

Lê Thanh Hải

03/14/1992​

7​

. . . . . . . .

& nhiệm vụ đề ra là lập 1 macro để nó liệt kê & nhắc nhỡ ta những thượng đế nào sắp tớ sẽ có ngày sinh nhật;
MJacro đó có nội dung như sau:

Sub LapDSNgaySinhKH()
 Dim Rws As Long, W As Integer, J As Long, Ng As Integer, Dat As Date, Col As Integer
 Dim Arr()
 Dim Ma_TN As String
 
 Rws = [B2].CurrentRegion.Rows.Count
 Arr() = [B2].Resize(Rws, 6).Value
 ReDim aKQ(1 To Rws, 1 To 7)
 [T2].CurrentRegion.Offset(1).Clear
 For Ng = 2 To 0 Step -1
    Ma_TN = MaTN(Date - Ng)
    For J = 1 To UBound(Arr())
        Dat = Arr(J, 3)
        If Dat < #9/2/1945# Then Exit For
        If MaTN(Dat) = Ma_TN Then
            W = W + 1
            aKQ(W, 1) = W
            For Col = 2 To 6
                aKQ(W, Col) = Arr(J, Col - 1)
            Next Col
        End If
    Next J
 Next Ng
 If W Then
    [T2].Resize(W, 7).Value = aKQ()
    MsgBox "Xong Rôi!", , "Xin Chào!"
 End If
End Sub

Function MaTN(Optional ByRef Dat As Date) As String
 Const Alf As String = "0123456789ABCDEFGHIJKLMNPPQRTSUVWXYZ"

 If Dat = 0 Then Dat = Date
 MaTN = Mid(Alf, 1 + Month(Dat), 1) & Mid(Alf, 1 + Day(Dat), 1)
End Function