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

 

[SA_DQ]

Sắp xếp dữ liệu theo bảng màu có sẵn.
​

Giả dụ chúng ta có bảng dữ liệu như ở cột [A-B]
& 1 bảng màu định sẵn (đang ở cột [F-G]
Mong muốn là kết quả hiện lên ở 2 cột [i-J] như hiện có ở 2 cột bên phải nhất của bảng

	(B1)					(G1)		(i1)			(L1)
CSDL					Bảng màu			Kết quả			Mong muốn
Green	12.35				1	Blue					Blue	24.52
Green	21.25				2	Red					Blue	24.333
Green	23.14				3	Green					Blue	21.54
Green	13.5				4	White
Red	12.145				5	Black					Red	12.145
Red	201.32				6	Brown					Red	201.32
Black	201.22				7	Orange
Black	214.32										Green	12.35
Black	212.221										Green	21.25
White	21.255										Green	23.14
White	63.21										Green	13.5
Blue	24.52
Blue	24.333										White	21.255
Blue	21.54										White	63.21
Brown	24.95
Brown	24.66										Black	201.22
Brown	21.44										Black	214.32
Orange	264.4										Black	212.221
Orange	214.253
											Brown	24.95
											Brown	24.66
											Brown	21.44
											Orange	264.4
											Orange	214.253

Macro để cho ta kết quả mong muốn sẽ như sau:

Sub SapXepTheoMau()     'FIND() '
 Dim Rws As Long, W As Integer, Dng As Integer
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 
 Dng = [G3].CurrentRegion.Rows.Count        'Bang Màu  '
 Rws = [B3].CurrentRegion.Rows.Count        'CSDL   '
 ReDim Arr(1 To (Dng + Rws), 1 To 2)
 [i3].Resize(Dng + Rws, 2).Value = Arr()    'Xóa Du Liêu Lân Truóc  '
 Set Rng = [A2].Resize(Rws)
 For Each Cls In Range([G3], [G3].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        W = W + 1
        MyAdd = sRng.Address
        Do
            Arr(W, 1) = sRng.Value:         Arr(W, 2) = sRng.Offset(, 1).Value
            W = W + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 [i3].Resize(W, 2).Value = Arr()
End Sub

Chúc các bạn vui vẻ trong ngày!

 

[SA_DQ]

LỌC THEO DANH SÁCH MÃ CÔNG VỤ​

Chúng ta có 1 bảng danh sách theo câu trúc như sau:

MÃ NV

HỌ VÀ TÊN

Công vụ

LOẠI HĐLĐ

NGÀY BẮT ĐẦU

NGÀY KẾT THÚC

Hồ sơ

NAT00

Ngô Anh Tuấn

TS

36 tháng

04/03/2024

06/02/2024

Có

NAT01

Ngữ An Tú

CT

KXĐ

04/04/2024

06/03/2024

Thiếu

NJT00

Nguyễn Tuấn

CT

36 tháng

04/05/2024

06/04/2024

Có

NAT02

Ngô Trần An Tú

CT

KXĐ

04/06/2024

06/05/2024

Thiếu

FFT00

Đinh Đình Tý

CT

12 tháng

04/07/2024

06/06/2024

Có

DFT00

Dương Đỗ Tú

TV

12 tháng

04/08/2024

06/07/2024

Thiếu

FDT00

Đỗ Dung Tấn

TV

12 tháng

04/09/2024

06/08/2024

Có

FDT01

Đỗ Dung Thanh

CT

KXĐ

04/10/2024

06/09/2024

Thiếu

FDT02

Đỗ Dung Thành

CT

KXĐ

04/11/2024

06/10/2024

Có

FDT03

Đỗ Dung Tài

CT

12 tháng

04/12/2024

06/11/2024

Có

FDT04

Đỗ Dung Tạn

CT

KXĐ

04/13/2024

06/12/2024

Có

FDT05

Đỗ Dung Tân

CT

KXĐ

04/14/2024

06/13/2024

Có

FDT06

Đỗ Dung Tận

CT

36 tháng

04/15/2024

06/14/2024

Có

FDT07

Đỗ Dung Thà

CT

12 tháng

04/16/2024

06/15/2024

Có

Ở cột 'Công vụ' hiện ta có 3 mã;
Nhiệm vụ đề ra là ta cần lọc theo từng mã công vụ này đưa vào từng trang tính có tên tương ứng với công vụ đó
Các bạn tham khảo theo file.
Trong file có macro sự kiện để giúp ta khi kích hoạt trang nào thì tiến hành lọc từ danh sách nguồn theo mã công vụ
Chúc các bạn có tuần làm việc vui vẻ & thành công!