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

  • Thread starter SA_DQ
  • Ngày gửi
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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)



Mã hóa.jpg
 
  • Like
Reactions: MINA
Khóa học Quản trị dòng tiền
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
Đáp án #1:
PHP: 
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
 
  • Like
Reactions: Nguyencongthuy
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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!


Đồng niên.jpg
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
& đây là bài giải:

PHP: 
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
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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
 

Đính kèm

  • TongHop.rar
    33.7 KB · Lượt xem: 2
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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:
ABCDEFABCDEFTổng
39​
123450​
123450
15​
987654​
987654
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:

PHP: 
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
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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:

STTMã KHHọ & TênNgày sinhĐTMSTĐC
1BXT00Bùi Xuân Thắm
02/27/1977​
1​
2BXT01Bùi Thị Xuân Thành
02/28/1978​
3​
3CCH00Châu Chấn Huy
03/01/1979​
5​
4CJL00Cù Lân
03/02/1980​
1​
5CMN00Công Tằng Tôn Nữ Minh Nguyệt
03/03/1981​
3​
6CNM00Công Tằng Tôn Nữ Nguyệt Minh
03/04/1982​
5​
7CNS00Chu Ngọc Sơn
03/05/1983​
7​
8CVA00Cỗ Văn Ẩn
03/06/1984​
3​
9DAH00Dương Ánh Hòa
03/07/1985​
5​
10FFD00Đào Đức Dương
03/08/1986​
7​
11FFD01Đỗ Đăng Dung
03/09/1987​
2​
12FLT00Đinh La Thăng
03/10/1988​
5​
13LCM00Lê Công Minh
03/11/1989​
7​
14LCM01Lã Chí Mai
03/12/1990​
2​
15LCT00Lê Công Thành
03/13/1991​
4​
16LTH00Lê 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:

PHP: 
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
Mã: 
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
 
Sửa lần cuối:
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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)
CSDLBảng màuKết quảMong muốn
Green12.351BlueBlue24.52
Green21.252RedBlue24.333
Green23.143GreenBlue21.54
Green13.54White
Red12.1455BlackRed12.145
Red201.326BrownRed201.32
Black201.227Orange
Black214.32Green12.35
Black212.221Green21.25
White21.255Green23.14
White63.21Green13.5
Blue24.52
Blue24.333White21.255
Blue21.54White63.21
Brown24.95
Brown24.66Black201.22
Brown21.44Black214.32
Orange264.4Black212.221
Orange214.253
Brown24.95
Brown24.66
Brown21.44
Orange264.4
Orange214.253

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

PHP: 
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!
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
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Ã NVHỌ VÀ TÊNCông vụLOẠI HĐLĐNGÀY BẮT ĐẦUNGÀY KẾT THÚCHồ sơ
NAT00Ngô Anh TuấnTS36 tháng04/03/202406/02/2024Có
NAT01Ngữ An TúCTKXĐ04/04/202406/03/2024Thiếu
NJT00Nguyễn TuấnCT36 tháng04/05/202406/04/2024Có
NAT02Ngô Trần An TúCTKXĐ04/06/202406/05/2024Thiếu
FFT00Đinh Đình TýCT12 tháng04/07/202406/06/2024Có
DFT00Dương Đỗ TúTV12 tháng04/08/202406/07/2024Thiếu
FDT00Đỗ Dung TấnTV12 tháng04/09/202406/08/2024Có
FDT01Đỗ Dung ThanhCTKXĐ04/10/202406/09/2024Thiếu
FDT02Đỗ Dung ThànhCTKXĐ04/11/202406/10/2024Có
FDT03Đỗ Dung TàiCT12 tháng04/12/202406/11/2024Có
FDT04Đỗ Dung TạnCTKXĐ04/13/202406/12/2024Có
FDT05Đỗ Dung TânCTKXĐ04/14/202406/13/2024Có
FDT06Đỗ Dung TậnCT36 tháng04/15/202406/14/2024Có
FDT07Đỗ Dung ThàCT12 tháng04/16/202406/15/2024Có

Ở 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!
 

Đính kèm

  • Download.rar
    22.4 KB · Lượt xem: 0
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
Chúng ta có 1 bảng dữ liệu như sau:
STTMã SốHọ tênNơi sinhĐịa chỉTháng 1Tháng 2Tổng
111Nguyễn Văn AnNDDN100,000200,000300,000
222Nguyễn Văn Ba-200,000200,000
333Đặng Thị Ca300,000-300,000
444Vũ Văn Dy200,000200,000400,000
555Ngô Thị Em300,000-300,000

Nhu cầu là cần tái bố trí lại thành 1 bảng sau:

Họ tênNơi sinhĐịa chỉTháng 1Tháng 2
Nguyễn Văn AnNDDN100,000
Nguyễn Văn AnNDDN-200,000
Nguyễn Văn Ba-200,000
Đặng Thị Ca300,000-
Vũ Văn Dy200,000-
Vũ Văn Dy-200,000
Ngô Thị Em300,000-

Dưới đây là macro để thực hiện mong muốn đó:

PHP: 
Sub XepLaiBang()
 Dim Rws As Long, W As Integer, Col As Integer, Cot As Integer
 Dim Rng As Range, Cls As Range
 
 Rws = [C3].End(xlDown).Row
 Set Rng = [F3].Resize(Rws, 2)
 ReDim Arr(1 To 2 * Rws, 1 To 7)
1  [A20].Resize(5+Rws, 7).Value = Arr()
 For Each Cls In Rng
    If Cls.Value > 0 Then
        W = W + 1:              Arr(W, 1) = W
        For Col = 2 To 5
            Arr(W, Col) = Cells(Cls.Row, Col).Value
        Next Col
        Arr(W, Cls.Column) = Cls.Value
    End If
 Next Cls
 2 [A12].Resize(W, 7).Value = Arr()
End Sub
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
THÊM DÒNG CHO BẢNG DANH SÁCH THEO SỐ ĐÃ CHỈ ĐỊNH
​
Chúng 6ta có bảng danh sách nhân viên như dưới đây:


Mã NVHọ và TênSố dòng
FHH00ĐẶNG HỮU HÀO4
FHT00ĐẶNG TRẦN HOÀNG TRINH3
FNA00ĐOÀN THỊ NGUYỆT ANH8
HNP00HÀ NGỌC PHƯỚC2
HTL00HỒ BẢO THÙY LINH2
HTT00HUỲNH THỊ THU THỦY9
LFH00LÊ ĐÌNH HIỀN2
LHL00LÊ TRƯƠNG HOÀNG LONG2
LQS00LƯƠNG QUANG SÁNG1
LVT00LẠI VĂN TUẤN3
MTT00MAI THANH TRÚC2
NBT00NGUYỄN THỊ BÍCH TRÂM4
NDH00NGUYỄN DUY HIẾU1
NKN00NGUYỄN THỊ KIM NGÂN1
NNH00NGUYỄN NGỌC HUY1
NNH00NGUYỄN NGỌC HANH8
. . .. . . .2

Nhiệm vụ đề ra của bài tập là: Cần thêm số dòng cho mỗi nhân viên theo số đã chỉ định (Ở cột thứ 3)
Nhiệm vụ này được thực hiện bỡi con macro sau:

PHP: 
Dim Arr()
Sub LapDSDongMayMan()
 Dim Rws As Long, J As Long, W As Integer, Tong As Long, Dg As Integer, SF As Integer
 Dim Cls As Range, WF As Object, MaNV
 Dim Ten As String
 
 Sheets("Du Lieu").Select
 Rws = Sheets("Du Lieu").UsedRange.Rows.Count
 Set WF = Application.WorksheetFunction
 Tong = WF.Sum([C2].Resize(Rws))
 [E2].Resize(Tong + 9, 3).Value = ""
 ReDim Arr(1 To Tong, 1 To 3)
 For Each Cls In [A2].Resize(Rws)
    MaNV = Cls.Value:               Ten = Cls.Offset(, 1).Value
    SF = Cls.Offset(, 2).Value
    For Dg = 1 To SF
        W = W + 1:                  Arr(W, 1) = W
        Arr(W, 2) = MaNV:           Arr(W, 3) = Ten
    Next Dg
 Next Cls
 [E2].Resize(W, 3).Value = Arr()
 MsgBox "Xong Nha!", , W
End Sub

& kết quả sau khi chạy macro ta sẽ nhận được bảng như sau:


STTMã NVHọ và Tên
1FHH00ĐẶNG HỮU HÀO
2FHH00ĐẶNG HỮU HÀO
3FHH00ĐẶNG HỮU HÀO
4FHH00ĐẶNG HỮU HÀO
5FHT00ĐẶNG TRẦN HOÀNG TRINH
6FHT00ĐẶNG TRẦN HOÀNG TRINH
7FHT00ĐẶNG TRẦN HOÀNG TRINH
8FNA00ĐOÀN THỊ NGUYỆT ANH
9FNA00ĐOÀN THỊ NGUYỆT ANH
10FNA00ĐOÀN THỊ NGUYỆT ANH
11FNA00ĐOÀN THỊ NGUYỆT ANH
12FNA00ĐOÀN THỊ NGUYỆT ANH
13FNA00ĐOÀN THỊ NGUYỆT ANH
14FNA00ĐOÀN THỊ NGUYỆT ANH
15FNA00ĐOÀN THỊ NGUYỆT ANH
16HNP00HÀ NGỌC PHƯỚC
17HNP00HÀ NGỌC PHƯỚC
18HTL00HỒ BẢO THÙY LINH
19HTL00HỒ BẢO THÙY LINH
20HTT00HUỲNH THỊ THU THỦY
21HTT00HUỲNH THỊ THU THỦY
22HTT00HUỲNH THỊ THU THỦY
23HTT00HUỲNH THỊ THU THỦY
24HTT00HUỲNH THỊ THU THỦY
25HTT00HUỲNH THỊ THU THỦY
26HTT00HUỲNH THỊ THU THỦY
27HTT00HUỲNH THỊ THU THỦY
. .. . .. . .
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
Theo dõi dòng tiền từ các hợp đồng​
Chùng ta có các hợp đồng & qui định kèm theo chúng là những điều kiện thanh toàn như ví dụ dẫn ra sau đây:
[/CENTER]
HĐ 01Tiến độ, ngày% thanh toán
10/20/2024​
HĐ 02Tiến độ% thanh toán
10/30/2024​
HĐ 03Tiến độ% thanh toán
11/5/2024​
Tổng giá trị HĐ50,000,000,000Tổng giá trị HĐ40,000,000,000Tổng giá trị HĐ100,000,000,000
Đợt TTĐợt TTĐợt TT
Đợt 1 (đặt cọc)
10/20/2024​
500,000,000Đợt 1 (đặt cọc)
10/30/2024​
500,000,000Đợt 1 (đặt cọc)
11/5/2024​
500,000,000
Đợt 23
30%​
14,500,000,000Đợt 23
30%​
11,500,000,000Đợt 23
30%​
29,500,000,000
Đợt 315
40%​
20,000,000,000Đợt 315
40%​
16,000,000,000Đợt 315
40%​
40,000,000,000
Đợt 4270
25%​
12,500,000,000Đợt 4270
25%​
10,000,000,000Đợt 4270
25%​
25,000,000,000
Đợt 5300
5%​
2,500,000,000Đợt 5300
5%​
2,000,000,000Đợt 5300
5%​
5,000,000,000


NNhiệm vụ đề ra là: Những ngày ký hợp đồng mới là dự kiến;
Khi nào ký chính thức sẽ phải chuyển số tiền trong các hợp đồng vô các tháng tương ứng để theo dõi các phát sinh hay thay đổi (Như bảng đính kèm):
​
STTThángNămTổng thángHĐ 01HĐ 02HĐ 03HĐ 04
1102024500,000,000
500,000,000​
211202497,500,000,000
27,500,000,000​
70,000,000,000​
31220240
4120250
5220250
6320250
7420250
8520250
9620250
107202510,000,000,000
10,000,000,000​
118202527,000,000,000
2,000,000,000​
25000000000​
12920255,000,000,000
5000000000​
131020250
141120250
151220250
16120260

Để thực hiện việc đó ta xài macro sự kiện như sau:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rws As Long, J As Long, W As Integer, fDat As Date, lDat As Date
Dim Sh As Worksheet, Rng As Range, sRng As Range

If Target.Row = 1 And Target.Column Mod 5 = 0 Then
    Set Sh = ThisWorkbook.Worksheets("CSDL")
    Set Rng = Sh.Range(Sh.[D1], Sh.Cells(1, Sh.UsedRange.Columns.Count))
    Set sRng = Rng.Find(Target.Offset(, -3), , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Rws = Sh.UsedRange.Rows.Count
        sRng.Offset(1).Resize(Rws).Value = ""   'Xóa Du Liêu Có Truóc   '
        ReDim Arr(1 To 5, 1 To 2)               'Chép Du Liêu Hop Dông  '
        Arr(1, 1) = Target.Value:   Arr(1, 2) = Target.Offset(3).Value
        For J = 2 To 5
            Arr(J, 1) = Arr(1, 1) + Target.Offset(2 + J, -2).Value
            Arr(J, 2) = Target.Offset(2 + J).Value
        Next J
    End If
    Target.Offset(9, -1).Resize(5, 2).Value = Arr()
    For W = 1 To 5
        For J = 2 To Rws
            fDat = DateSerial(Sh.Cells(J, "C").Value, Sh.Cells(J, "B").Value, 1)
            lDat = DateSerial(Sh.Cells(J, "C").Value, 1 + Sh.Cells(J, "B").Value, 0)
            If Arr(W, 1) >= fDat And Arr(W, 1) <= lDat Then
                Sh.Cells(J, sRng.Column).Value = _
                    Format((Arr(W, 2) + Sh.Cells(J, sRng.Column).Value), "###")
            End If
        Next J
    Next W
End If
End Sub
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
TẠO RA 1 BẢNG GỒM 100 HÀNG & 20 CỘT KHÔNG TRÙNG TRONG 1 HÀNG​

Với điều kiện nữa là các số trong bảng này chỉ từ 1 cho đến 80
Marco để thực hiện điều này đơn giản nhất có thể là:

PHP: 
Sub TaoBangDuLieuKhongTrung()
 Dim W As Integer, J As Integer, Ngau As Integer
 Dim NumStr As String, Tmp As String
 
 For W = 1 To 80
    NumStr = NumStr & Right("0" & CStr(W), 2)
 Next W
 ReDim Arr(1 To 100, 1 To 20) As Integer
 Randomize
 For J = 1 To 100
    Tmp = NumStr
    For W = 1 To 20
        Ngau = 1 + 35 * Rnd() \ 1
        If Ngau Mod 2 = 0 Then Ngau = Ngau + 1
        Arr(J, W) = CInt(Mid(Tmp, Ngau, 2))
        Tmp = Mid(Tmp, Ngau + 2, Len(Tmp)) & Left(Tmp, Ngau - 1)
    Next W
 Next J
 [A3].Resize(100, 20).Value = Arr()
End Sub
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
Lọc lấy tên chủ tài khoản​

Chúng ta có 1 bảng dữ liệu tương đối lộn xộn;
Thường cụm từ chủ TK (tài khoản) nằm ngay sau cụm từ 'Mua Sam', hay 'MUA SAM' hoặc 'mua sam'
& cũng có những dòng không chứa 1 trong các cụm từ này;
Trong trường hợp sau cùng đó, ta lọc lấy hết, vì đó là tên của chủ TK;
Nhưng cũng có 1 số trường hợp sau cụm từ của chủ TK còn ghi thêm SĐT hay số CCCD,. . . .


DỮ LIỆU GỐCDỮ LIỆU TRẢ VỀ
​
9395593955
888882015888882015
9SFP36S9SFP36S
A1117A1117
DOITRAADOITRAA
DUY656ADUY656A
HUNGLLO95HUNGLLO95
IBFT mua sam NDN1998B 029290 029290NDN1998B=FDT(A9)
mua sam 08629992010862999201
mua sam VOTUNGSON1VOTUNGSON1
NANGLE203NANGLE203
MUA SAM 414141414141
mua sam AMATHAOAMATHAO
mua sam ANHBEO991ANHBEO991
mua sam ANHKHOA921ANHKHOA921
mua sam ANHKHOROI 293240 293240ANHKHOROI
mua sam ANHTU98AANHTU98A
mua sam AQUANG339AQUANG339
mua sam CHICKEN688CHICKEN688
mua sam CHT1999CHT1999
mua sam CUSEUCUSEU
mua sam CX5138 315062 315062CX5138

Nhiệm vụ đề ra là viết 1 hàm người dùng, ma hàm này khi được cung cấp dữ liệu nguồn sẽ trả về là mã hay tên của chủ TK
Hàm này sẽ có nội dung như sau đây:

PHP: 
Option Explicit
Function FDT(Rng As Range) As String    'Hàm Loc Tên Tài Khoan   '
 Const MS As String = "MUA SAM":        Dim StrC As String
 Dim VTMS As Byte, VTTr As Byte
 
 StrC = Rng.Value
 VTMS = InStr(1, StrC, MS, vbTextCompare)
 If VTMS Then
    StrC = Mid(StrC, 1 + VTMS + Len(MS), Len(StrC)) 'Cát Dàu "*" & MS    '
    VTTr = InStr(1 + Len(MS), StrC, " ")
    If VTTr Then
        FDT = RTrim$(Left(StrC, VTTr))  'Cát Duôi   '
    Else
        FDT = StrC                      'Không Có Duôi  '
    End If
 Else
    FDT = StrC
 End If
End Function

Chúc các bạn nhiều niềm vui trong những ngày cuối tuần!
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
CHUYỂN BẢNG DỌC THÀNH BẢNG NGANG​
Chúng ta có bảng dữ liệu doanh thu của nhân viên theo mã ngày (Bảng bên trái)
Giờ nhiệm vụ đề ra là phân tích doanh thu từng người nhân viên theo các ngày: (bảng bên phải)
Mã ngàyMã NVKQuaMãDJS00DQS00DYH00DQF00DFC00
EC1DJS0065EC1655000
EC1DQS005EC20070100
EC2DYH0070EC30015075
EC2DQF0010EC48000020
EC3DFC0075EC52585000
EC3DYH0015EC60300900
EC4DJS0080EC70095350
EC4DFC0020EC80854000
EC5DQS0085EC90450750
EC5DJS0025ECA0065500
EC6DQF0090ECB0055055
EC6DQS0030ECC4500060
EC7DYH0095
EC7DQF0035
EC8DQS0085
EC8DYH0040
EC9DQF0075
EC9DQS0045
ECADYH0065
ECADQF0050
ECBDYH0055
ECBDFC0055
ECCDFC0060
ECCDJS0045


Để có được kết quả (như bảng bên phải) có thể ta xài macro sau:

PHP: 
Sub ViDuXaiDSUM()
 Dim Rws As Long, Col As Integer, Dg As Long
 Dim WF As Object, CSDL As Range
 
 Set WF = Application.WorksheetFunction
 Set CSDL = [B2].CurrentRegion
 [E15].Value = [B1].Value:          [F15].Value = [C1].Value
 For Dg = 2 To 13
    [E16].Value = Cells(Dg, "G").Value
    For Col = 8 To 12   'Côt H => K '
        [F16].Value = Cells(1, Col).Value
        Cells(Dg, Col).Value = WF.DSum(CSDL, [D1], [E15:F16])
    Next Col
 Next Dg
End Sub
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
Đề bài:
Tạo ra 1 bảng số nguyên ngẫu nhiên tăng dần trong 8 hàng & 12 cột
từ 999 số bắt đầu từ số 1


Như bảng sau:

467101417192024272931
353840424344475154576062
667072747780838690919596
101104108110113114118120121124126129
133136138139143147151155159162165168
173174176178180182186187190192195197
200202206209212213214218220223227231
233236239242246249253255256259262266

Hàm người dùng có nội dung sau:

PHP: 
Function BangNgauSo(Optional Rws As Byte = 8, Optional Col As Byte = 12, _
    Optional Min_ As Integer = 1, Optional Max_ As Integer = 999)
 Dim J As Integer, W As Integer, Z As Integer, Tmp As Integer
 
 If Rws > 8 Then Rws = 8
 If Col > 12 Then Col = 12
 ReDim Arr(1 To 8, 1 To 12) As String
 Randomize:             Tmp = 1
 For J = 1 To 8
    Tmp = Tmp + 1
    For Z = 1 To 12
        Tmp = 1 + Tmp + 3 * Rnd() \ 1
        Arr(J, Z) = Str(Tmp)
    Next Z
 Next J
 BangNgauSo = Arr()
End Function
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
VIẾT HÀM NGƯỜI DUNG ĐỂ TRA NGƯỢC 1 BẢNG GIÁ TRỊ.​
Giả dụ chúng ta có 1 bảng giá trị như sau:

|
TáoMítCamXoàiỔiNaKhế
A1234567
B5671234
VD2Cần tìmI2C6712345
ỔiD7123456
E3456712
F2345671
G5671234
H7123456
I5671234
K7123456

Nhiệm vụ đề ra là: Viết 1 hàm người dùng để khi ta cung cấp tên của dòng (ví dụ I) & 1 trị số (có trong dòng đó) thì hàm sẽ trả về tên loại trái cây (tiêu đề cột) thuộc về các trị mà ta đã cung cấp
Có nghĩa là khi tham biến thứ 2 ta cung cấp là 2 thì hàm trả về 'ổi'
Hàm cần viết có nội dung sau:

PHP: 
Function TraBang(Hang As String, Cot As Integer, Optional Bang As Range)
 If Bang Is Nothing Then Set Bang = [G5:N15]
 Dim Rng As Range, sRng As Range, Cls As Range
 
 Set Rng = Bang(1).Resize(Bang.Rows.Count)
 TraBang = "Nothing!"
 Set sRng = Rng.Find(Hang, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
    For Each Cls In sRng.Resize(, Bang.Columns.Count)
        If Cls.Value = Cot Then
            TraBang = Bang(Cls.Column - Bang(0).Column).Value
            Exit Function
        End If
    Next Cls
 End If
End Function
 
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
594
104
43
67
HCM city
Nhiệm vụ lần này của bài tập là lập tất thẩy các số nguyên tố gồm 3 ký số như bảng kèm theo:L
101211307401503601701809907
103223311409509607709811911
107227313419521613719821919
109229317421523617727823929
113233331431541619733827937
127239337433547631739829941
131241347439557641743839947
137251349443563643751853953
139257353449569647757857967
149263359457571653761859971
151269367461577659769863977
157271373463587661773877983
163277379467593673787881991
167281383479599677797883997
173283389487683887
179293397491691
181499
191
193
197
199
Để vậy, chúng ta xài macro sau:

PHP: 
Sub BangSoNguyenTo111_999()
 Dim Rw As Integer, Col As Integer, Num As Integer, Cot As Integer, RwMax As Integer
 ReDim Arr(1 To 50, 1 To 9) As String

 Sheets("GPE").Select
 [A1].Resize(50, 9).Value = Space(0)
 For Num = 101 To 999 Step 2
    If IsPrime(Num) Then
        Col = Num \ 100
        If Col > Cot Then
            If Rw > RwMax Then RwMax = Rw
            Cot = Col:                  Rw = 1
        Else
            Rw = Rw + 1
        End If
        Arr(Rw, Col) = Str(Num)
    End If
 Next Num
 [A1].Resize(RwMax, 9).Value = Arr()
End Sub
=
Mã: 
Function IsPrime(n As Integer) As Boolean
 Dim i As Integer
 For i = 2 To Sqr(n)
    If n Mod i = 0 Then
        IsPrime = False:            Exit Function
    End If
 Next i
 IsPrime = True
End Function
 
Bạn phải đăng nhập hoặc đăng ký để bình luận.

Xem nhiều

Liên kết

Tâm An kế toán quản trị

Chia sẻ trang

Share this page
Webketoan Zalo OA
Top Bottom