Bài tập VBA đơn giản dành cho người mới bắt đầu [Phần 2]

[ChanhTQ@]

Xin các bạn có bài tập nào hay hay đăng lên để cùng nhau luyện cho mau tiến bộ nhe!
Mình xin mở màn bài đầu:

ĐỀ BÀI 1:
​

Tôi có bảng số liệu từ cột [A..E] như sau:

| A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W 2 |HoTen|Date1|Date2|Date3|Date4|1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16|17|18
3 |Hồ Lễ|3|5|7|13|Do|Do|Do|Xh|Xh|Vg|Vg|Tm|Tm|Tm|Tm|Tm|Tm||.|||
4 |Đỗ Nè|4|8|13|15|Nu|Nu|Nu|Nu|Xh|Xh|Xh|Xh|Xm|Xm|Xm|Xm|Xm|Dn|Dn|||
5 |Vũ Xe|2|4|12|13|Do|Do|Vg|Vg|Nu|Nu|Nu|Nu|Nu|Nu|Nu|Nu|Hg|||.|||

Phần từ cột [F] trở đi là phần cần viết 1 macro để nó tô màu nền khác nhau theo những giá trị cùng dòng từ cột [B..E];
Màu tô do bạn tự chọn, cốt fân biệt giữa chúng & dịu mắt là được!


PHẦN TỔNG HỢP CÁC ĐỀ BÀI TẬP:

Tên|Tóm tắc|Bài thứ
Đề bài 1|Tô màu theo trị số các ô bên trái cùng dòng| #1
Đề bài 1A|Lọc theo các số cần thiết từ các chuỗi số| #73
Đề bài 1B|Xác định loại tam giác dựa trên 3 số ngẫu nhiên được tạo ra| #82
Đề bài 2|Lập danh sách học sinh theo từng lớp| #11
Đề bài 2A|Dịch ngôn ngữ VBA sang tiếng Việt| #19
BĐT(*)|Lập danh sách các nữ HS có ngày sinh trong 1 quí| #101
Đề bài 3|Thống kế kết quả điểm của từng lớp theo từng môn học| #22
Đề bài 4|Lập danh sách HS các lớp đạt điểm cực trị của từng môn| #46
Đề bài 4A|Tìm trong danh sách thí sinh, số báo danh nào có tổng điểm các môn cao nhất| #94
Đề bài 5|Thống kê từng khoảng điểm của môn học| #58
Đề bài 6|Thống kê điểm trung bình theo giới tính| #71

(*) BĐT: Bài đọc thêm

.
.
.

 

[Hau151978]

Các thầy ra đề khó quá, 1 vòng lặp, không dùng Replace, dĩ nhiên không dùng Dictionary.

Function TimViTri2$(ByVal ChuoiGoc$, ByVal ChuoiTim$)
    Dim i&, s$, tmp$, k&, arr(1 To 1000) As Long
    For i = 1 To Len(ChuoiTim)
        s = Mid(ChuoiTim, i, 1)
        tmp = Left(ChuoiTim, i - 1)
        k = InStrRev(tmp, s)
        If k > 0 Then k = arr(k)
        arr(i) = InStr(k + 1, ChuoiGoc, s)
        TimViTri2 = TimViTri2 & arr(i) & "_"
    Next
    If Len(TimViTri2) > 0 Then TimViTri2 = Left(TimViTri2, Len(TimViTri2) - 1)
End Function
Sub test()
    MsgBox TimViTri2("CCABAEBAC", "CACBAA")
End Sub

 

[SA_DQ]

Bổ sung 1 vòng lặp để loại bỏ điều kiện ("$")

Em xin tham gia câu 2, điều kiện chuỗi tìm kiếm không có "$"
(Bài 116)

Option Explicit
Dim TuTT As String, ChuoiGoc$
Sub test()
 Const KhongGiongAi As String = "_|!@#$%^&()-=+*"   '<=|'
 Dim J As Long
 
 ChuoiGoc$ = "ABAEBAC"
 For J = 1 To Len(KhongGiongAi)
    TuTT = Mid(KhongGiongAi, J, 1)
    If Not InStr(ChuoiGoc, TuTT) Then
        Exit For
    End If
 Next J
 MsgBox TimViTri(ChuoiGoc$, "ABAAC"), , ChuoiGoc$
End Sub

[B]Function TimViTri$(ByRef ChuoiGoc$, ByVal ChuoiTim$)[/B]   
 Dim I&, S$
    For I = 1 To Len(ChuoiTim)
        S = Mid(ChuoiTim, I, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, S) & "_"
        ChuoiGoc = Replace(ChuoiGoc, S, TuTT, 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
[B]End Function[/B]

 

[chuot0106]

Option Explicit
Dim TuTT As String, ChuoiGoc$
Sub test()
 Const KhongGiongAi As String = "_|!@#$%^&()-=+*"   '<=|'
 Dim J As Long
 
 ChuoiGoc$ = "ABAEBAC"
 For J = 1 To Len(KhongGiongAi)
    TuTT = Mid(KhongGiongAi, J, 1)
    If Not InStr(ChuoiGoc, TuTT) Then
        Exit For
    End If
 Next J
 MsgBox TimViTri(ChuoiGoc$, "ABAAC"), , ChuoiGoc$
End Sub

[B]Function TimViTri$(ByRef ChuoiGoc$, ByVal ChuoiTim$)[/B]   
 Dim I&, S$
    For I = 1 To Len(ChuoiTim)
        S = Mid(ChuoiTim, I, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, S) & "_"
        ChuoiGoc = Replace(ChuoiGoc, S, TuTT, 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
[B]End Function[/B]

Những cái này với người mới bắt đầu e rằng hơi quá sức thầy ạ. Đó là lí do tại sao ko có thành viên mới học vba nào dám tham gia.
Em nghĩ với đề bài này thì cứ cho thành viên mới dùng 2 vòng for đi, hay nhiều hơn miễn sao họ ra kết quả.

 

[phihndhsp]

Option Explicit
Dim TuTT As String, ChuoiGoc$
Sub test()
 Const KhongGiongAi As String = "_|!@#$%^&()-=+*"   '<=|'
 Dim J As Long
 
 ChuoiGoc$ = "ABAEBAC"
 For J = 1 To Len(KhongGiongAi)
    TuTT = Mid(KhongGiongAi, J, 1)
    If Not InStr(ChuoiGoc, TuTT) Then
        Exit For
    End If
 Next J
 MsgBox TimViTri(ChuoiGoc$, "ABAAC"), , ChuoiGoc$
End Sub

[B]Function TimViTri$(ByRef ChuoiGoc$, ByVal ChuoiTim$)[/B]   
 Dim I&, S$
    For I = 1 To Len(ChuoiTim)
        S = Mid(ChuoiTim, I, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, S) & "_"
        ChuoiGoc = Replace(ChuoiGoc, S, TuTT, 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
[B]End Function[/B]

nếu đã viết function thì tham số chỉ nên là 1 chuỗi và 1 ký tự để so sánh

 

[VetMini]

Nếu tôi dạy môn học VBA. Và nếu tôi ra cái đề này cho học sinh của tôi tập, thì cách chấm điểm của tôi khác quý vị nhiều.

Với đề bài trên, học sinh nào giải ra thì tối đa chỉ được 75% điểm (7,5 điểm / 10)

Những học sinh nào đặt câu hỏi "có phải chuỗi thứ 2 là chuỗi thứ nhất đã cắt bớt vài ký tự bất kỳ? và nếu không phải thì những ký tự không tìm được thì xử lý ra sao?" sẽ được 2,5 điểm còn lại.

 

[SA_DQ]

Gởi chàng Chuột 0106:
Rất tán thành í kiến của bạn & xin cảm ơn;

Đề xuất 1 vòng lặp là do thầy Phi đưa ra 2 vòng lặp đó thôi; Lúc đó mọi người mới nêu rằng 1 vòng lặp cũng được;
Còn bài trên đưa ra vòng lặp để bỏ điều kiện "$" (tạm gọi là thế), nhưng cũng là gợi í nào đó để việc thay thế đảm bảo chắc chắn hơn mà thôi;
Theo mình thì bài này còn nhiều cách làm khác "Hàn lâm" hơn nhiều; Chúng ta cùng đợi những tham khảo từ các nhà siêu lập trình đưa ra tác fẩm kinh điển của mình.

Chúc ngày cuối tuần vui vẻ!

Những học sinh nào đặt câu hỏi "có phải chuỗi thứ 2 là chuỗi thứ nhất đã cắt bớt vài ký tự bất kỳ? và nếu không phải thì những ký tự không tìm được thì xử lý ra sao?" sẽ được 2,5 điểm còn lại.

Đúng vậy & chữ cái ta không tìm thấy đó sẽ nên điền số 0; Nhưng chưa "Học viên" nào hỏi mà!

nếu đã viết function thì tham số chỉ nên là 1 chuỗi và 1 ký tự để so sánh

Cái này là của người khác, mình chỉ thêm mắm, tiêu & ớt xíu thôi!

 

[VetMini]

...
Theo mình thì bài này còn nhiều cách làm khác "Hàn lâm" hơn nhiều; Chúng ta cùng đợi những tham khảo từ các nhà siêu lập trình đưa ra tác fẩm kinh điển của mình.

Chúc ngày cuối tuần vui vẻ!

Theo tôi thì nếu không xác định vấn đề ở vài #125 thỉ tất cả mọi lời giải đều là giải mò.

 

[Hau151978]

Nếu tôi dạy môn học VBA. Và nếu tôi ra cái đề này cho học sinh của tôi tập, thì cách chấm điểm của tôi khác quý vị nhiều.

Với đề bài trên, học sinh nào giải ra thì tối đa chỉ được 75% điểm (7,5 điểm / 10)

Những học sinh nào đặt câu hỏi "có phải chuỗi thứ 2 là chuỗi thứ nhất đã cắt bớt vài ký tự bất kỳ? và nếu không phải thì những ký tự không tìm được thì xử lý ra sao?" sẽ được 2,5 điểm còn lại.

Những chữ không có thì điền số 0, các bài 116 và 121 em đều làm như vậy.

 

[Hau151978]

nếu đã viết function thì tham số chỉ nên là 1 chuỗi và 1 ký tự để so sánh

Nếu tham số là 1 chuỗi và 1 ký tự thì đó chính là hàm INSTR, cần gì phải dùng hàm riêng nữa?

 

[VetMini]

@Hau151978:
Hàm Replace không hữu hiệu bằng hàm Mid. Hàm mid trả về chính vị trí chuỗi, nó có thể nằm bên trái phép gán. Và đó là thủ thuật hiệu quả nhất để sửa một đoạn bên trong chuỗi.

@SA_DQ:
Theo nguyên tắc lập trình thì mọi vòng lặp đều có thể thay thế bằng đệ quy.
Nếu bạn đã dùng đệ quy để giảm 1 vòng lặp thì chả có lý do gì để không giảm luôn vòng lặp còn lại.

@các bạn mới tập:
Đây là bài tập tốt để thử nghiệm tầm hiểu biết của các bạn về vòng lặp và một vài hàm chuỗi, nếu bạn biết cả array thì dùng array để chứa kết quả và join một lần cuối thay vì dùng phép nối từng phần.
Tuy nhiên, bạn phải đặt ra 2 cấu hỏi như tôi đã đề cập trên:
Nếu chuỗi 2 là chuõi 1 đã cắt bớt thì có thể có cách khác để làm
Nếu chuỗi 2 không phải là chuỗi 1 cắt bớt thì phải có quy luật hiển thì các ký tự không tìm được.

 

[SA_DQ]

Bài tập "Giải mã ngày"

Mình có một hàm người dùng để mã hóa 1 ngày cụ thể nào đó thành chuỗi 3 kí tự;
Hàm đó có nội dung như sau:

Option Explicit
Function MaNgay(Optional Dat As Date)
 Const GPE$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
 If Dat = 0 Then Dat = Date
 MaNgay = Mid$(GPE, Year(Dat) - 2000, 1) & Mid$(GPE, 1 + Month(Dat), 1)
 MaNgay = MaNgay & Mid$(GPE, 1 + Day(Dat), 1)
End Function

Cách sử dụng hàm này là: Nếu ta cung cấp cho hàm 1 tham biến 1 số liệu biểu thị 1 ngày nào đó, thì hàm sẽ trả về cho ta chuỗi gồm 3 kí tự biểu thị cho ngày duy nhất đó
Ví dụ:
Nếu ta cung cấp tham biến 1/13/2015; hàm sẽ trả về chuỗi "E1D"
Nếu ta không cung cấp tham biến, hàm sẽ lấy ngày hiện hành thay thế, như
hôm nay hàm sẽ trả về chuỗi "E5L"


Nhiệm vụ của bài tập đề ra là:

Xin các bạn viết cho 1 hàm tự tạo, mà khi ta cung cấp chuỗi ngày được mã hóa bỡi hàm trên, thì hàm sẽ trả về ngày/tháng/năm mà hàm trên đã hóa giải.

Ví dụ cụ thể =NgayMa( "E1D") sẽ trả về ngày 1/13/2015


Chúc các bạn nhiều thành công!

 

[doveandrose]

đi xuôi xài mid thì đi ngược xài inStr
xuôi + 1 thì đi ngược -1
đầu xuôi không bẫy lỗi thì đầu ngược càng không cần
ví dụ ngày 1/1/2000 được chuyển thành 011 và đưa vào cell tự động đổi thành 11 vậy đi ngược dịch làm sao ra 1/1/2000

Public Function DateFrom3Char(ByVal chars As String) As Date
Const GPE = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
DateFrom3Char = DateSerial(InStr(GPE, Mid(chars, 1, 1)) + 2000, InStr(GPE, Mid(chars, 2, 1)) - 1, _
InStr(GPE, Mid(chars, 3, 1)) - 1)


End Function

 

[SA_DQ]

Vậy trong trường hợp này thì cần sửa lại hàm =MaNgay(Optional Dat As Date)

để hàm dịch ngược khỏi sai là như thế nào đây các bạn;

Các bạn khắc fục dùm lỗi mà Doveandrose đã nêu:
[thongbao]đầu xuôi không bẫy lỗi thì đầu ngược (??) cần
ví dụ ngày 1/1/2000 được chuyển thành 011 và đưa vào cell tự động đổi thành 11 vậy đi ngược dịch làm sao ra 1/1/2000
[/thongbao]

Xin cảm ơn trước nha!

 

[SA_DQ]

Bài tập Xếp lại trật tự cho 1 chuỗi

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

 

[chuot0106]

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

Không biết chuỗi ban đầu có dấu tiếng việt không vậy thầy?

 

[doveandrose]

cho em hỏi ngu 1 câu : "*" hoặc "%" so với "a" thì cái nào xếp trước ?

 

[chuot0106]

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

Tạm thời do tác giả không nói rõ nên code giải quyết trong trường hợp chuỗi không có dấu tiếng việt và không có kí tự đặc biệt.

Public Sub SapXepChuoi()
Dim i As Long, j As Long, chuoigoc As String, tmp As String
Dim kt As String, chuoicon As String, kt1 As String
    chuoigoc = "abcdefghijkomnpqr"
    chuoicon = "Ba cho con"
For i = 1 To Len(chuoigoc)
        kt = Mid(chuoigoc, i, 1)
    For j = 1 To Len(chuoicon)
        kt1 = Mid(chuoicon, j, 1)
        If Application.Proper(kt1) = Application.Proper(kt) Then tmp = tmp & kt1
    Next j
Next i
    MsgBox tmp
End Sub

 

[doveandrose]

trong lúc chờ tác giả xác định thì cho em nghịch dại cái này vậy

Public Function hello(ByVal old_str As String) As String
Application.ScreenUpdating = False
Dim ws As Worksheet, arr As Variant, rng As Range, n As Integer
If old_str = "" Then
    hello = ""
    Exit Function
End If
Set ws = ThisWorkbook.Worksheets.Add
ReDim arr(1 To Len(old_str), 1 To 1)
For n = 1 To Len(old_str) Step 1
    arr(n, 1) = Mid(old_str, n, 1)
Next
Set rng = ws.Range("A1:A" & UBound(arr))
rng.Value = arr
rng.Sort key1:=rng, order1:=xlAscending, MatchCase:=True
hello = WorksheetFunction.Trim(Join(WorksheetFunction.Transpose(rng.Value), ""))
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function

 

[Let'GâuGâu]

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

em xin nộp bài, nhưng mà chỉ có " Ba cho con" thôi nha thầy,,,"Ba cho con gái" thì em chịu

Public Function BaChoCon(rng As Range)
Dim st As String, tam(1 To 1000)
st = Trim(rng.Value)
For i = 1 To Len(st)
    tam(Asc(UCase(Mid(st, i, 1)))) = tam(Asc(UCase(Mid(st, i, 1)))) & Mid(st, i, 1)
Next
   BaChoCon = Trim(Join(tam, ""))
End Function

 

[SA_DQ]

Đề cương giải bài "Xếp lại trật tự cho 1 chuỗi" cho những người biết về biến mảng

Bằng cách viết hàm tự tạo:
Function XepChuoi("Chuỗi khảo sát")
Bước 1: Khai báo biến
1.1 Khai báo 1 hằng kiểu chuỗi = "ABCD.. . Z"
1.2 Khai báo 1 mảng gồm 26 hàng & số cột bằng chiều dài của chuỗi khảo sát (CKS)
1.3 Khai báo 1 biến đếm kiểu Byte (VT) & 1 biến đếm (J) kiểu Long (hay Integer)
1.4 Khai báo 1 biến kiểu chuỗi (Tmp)

Bước 2: Tạo vòng lặp duyệt từ đầu chí cuối CKS theo J
Cắt từng kí tự cho vô biến Tmp
Tìm kí tự đang chứa ở Tmp trong hằng bằng hàm InStr(); Giá trị tìm thấy gán vô biến VT
Nếu tìm thấy thì chép vô mảng tại dòng trùng với VT & cột trùng với vị trí của Tmp trong CKS
Nếu không tìm thấy thì
Tiếp tục tìm với hàm UCase$(Tmp)
& cũng chép vô mảng như trên đã nêu

Bước 3:
Lập vòng lặp duyệt qua các hàng của mảng (theo J)
Lập vòng lặp thứ 2 duyệt theo các cột của mảng (Theo VT)
Thực hiện tuần tự việv nối chuỗi, như
XepChuoi = XepChuoi & Arr(J, VT)
Next VT
Next J
End Function