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

.
.
.

 

[chuot0106]

Điều kiện trong hàm CSDL lấy ký tự đại diện, ví dụ điều kiện cột Lớp là 12A1 thì hàm sẽ lấy luôn dữ liệu có Lớp là 12A1* (ví dụ 12A11, 12A12, ...). Bạn test thử sẽ biết, nhưng chỉ lấy phần đầu, chứ không phải đại diện hoàn toàn (kiểu *12A1*).

Vậy cách khắc phục như thế nào đây anh. Áp dụng với code của em ạ???

 

[leonguyenz]

Vậy cách khắc phục như thế nào đây anh. Áp dụng với code của em ạ???

Đã nói ở bài #39 là thua luôn mà. Làm sao sử dụng DMAX, DMIN cho bài này được.
Cách còn lại để áp dụng code với hàm cơ sở dữ liệu là convert lại tên lớp về dạng 12A??, ví dụ 12A1 đến 12A9 thì chuyển về 12A01 đến 12A09, sau đó áp dụng code.

 

[chuot0106]

Đã nói ở bài #39 là thua luôn mà. Làm sao sử dụng DMAX, DMIN cho bài này được.
Cách còn lại để áp dụng code với hàm cơ sở dữ liệu là convert lại tên lớp về dạng 12A??, ví dụ 12A1 đến 12A9 thì chuyển về 12A01 đến 12A09, sau đó áp dụng code.

Em đã làm thử như anh nói đó là convert lại tên lớp về dạng 12A?? những vẫn không ra kết quả như tác giả đã đưa.

 

[leonguyenz]

Em đã làm thử như anh nói đó là convert lại tên lớp về dạng 12A?? những vẫn không ra kết quả như tác giả đã đưa.

Ví dụ A1 là tên lớp, đặt công thức chuyển lớp về dạng 12A??, vì là lớn 12A cả:

="12A"&TEXT(MID(A1,4,2),"00")

Kết quả trong file của bạn.

 

[SA_DQ]

Đọc & dịch macro sự kiện này nà

Để biết cách vượt qua cửa ải đó bằng cách nào:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, J As Byte:                Dim Txt As String
 Dim Sh As Worksheet, Rng As Range, WF As Object, Cls As Range, Cll As Range, Rg0 As Range
 
 Set Sh = ThisWorkbook.Worksheets("Sheet1")
 Rws = Sh.[h6].CurrentRegion.Rows.Count
 Set Rng = Sh.[h6].Resize(Rws, 7)
 Set Rg0 = Sh.[i6].Resize(, 6)
 Set WF = Application.WorksheetFunction
 If Not Intersect(Target, [H1]) Is Nothing Then
    Txt = Left(Target.Value, 1)
    For Each Cls In Range([b6], [b6].End(xlDown))
3        Sh.[AA4].Value = Cls.Value
        For J = 1 To 6
            If Txt = "C" Then
5                Cls.Offset(, J).Value = WF.DMax(Rng, Rg0(J), Sh.[AA1:AA2])
            Else
7                Cls.Offset(, J).Value = WF.DMin(Rng, Rg0(J), Sh.[AA1:AA2])
            End If
        Next J
    Next Cls
 End If
End Sub

 

[ChanhTQ@]

Bải tập 4: Lập danh sách tất cả học viên đạt tối đa/tối thiểu theo từng môn.

ĐỀ BÀI 4
​

Dựa vô bảng điểm của bài 3, xin các bạn lập ra danh sách các học viên đạt điểm tối đa hay tối thiểu của khối 12 này.


Trên diễn đàn gần đây có loại bài này rồi; Các bạn có thể tham khảo để có thể làm hay hơn!

Chúc thành công!

Mẫu báo cáo:

DANH SÁCH CÁC EM HOC VIÊN ĐẠT ĐIỂM TỐI ĐA/TỐI THIỂU

TT|HoTen|Lop|Văn|Lí|Địa|Toán|Sinh|Anh
01|Trần Hồ|12A9| 10 |5|6|..| 9| 6
02|Lê La|12A7|4| 8 |7|. . . .|6|5.5
03|Vủ Phu|12A|8| 7.5 |. | . |5|6.5
..|||. . .|..|

 

[phihndhsp]

ĐỀ BÀI 4
​

Dựa vô bảng điểm của bài 3, xin các bạn lập ra danh sách các học viên đạt điểm tối đa hay tối thiểu của khối 12 này.


Trên diễn đàn gần đây có loại bài này rồi; Các bạn có thể tham khảo để có thể làm hay hơn!

Chúc thành công!

Mẫu báo cáo:

DANH SÁCH CÁC EM HOC VIÊN ĐẠT ĐIỂM TỐI ĐA/TỐI THIỂU

TT|HoTen|Lop|Văn|Lí|Địa|Toán|Sinh|Anh
01|Trần Hồ|12A9| 10 |5|6|..| 9| 6
02|Lê La|12A7|4| 8 |7|. . . .|6|5.5
03|Vủ Phu|12A|8| 7.5 |. | . |5|6.5
..|||. . .|..|

em chưa hiểu bài này lắm, điểm tối đa của các môn hay là sao? với lại bài 3 là điểm lớn nhất của từng cột nên nó sẽ không đồng nhất với từng dòng?
hay là sư phụ muốn tìm ra ai đó có điểm cao nhất rồi đưa ra tên của người đó trong danh sách em chép về hình như là không có tên trần hồ
nếu bài này dựa vào danh sách bài 3 rồi tìm ra điểm max từng dòng sau đó sử so sánh điểm max với CSDL để lấy ra tên thì em có thể sử dụng lưu lại vị trí max/min rồi truy cập tới nó để lấy ra tên

 

[chuot0106]

em chưa hiểu bài này lắm, điểm tối đa của các môn hay là sao? với lại bài 3 là điểm lớn nhất của từng cột nên nó sẽ không đồng nhất với từng dòng?
hay là sư phụ muốn tìm ra ai đó có điểm cao nhất rồi đưa ra tên của người đó trong danh sách em chép về hình như là không có tên trần hồ

Em cũng chung băn khoăn với anh.

 

[SA_DQ]

Thì bài trên ta biết điểm tối đa của lớp 12A1 là 10(V), 5(L), 6(D), 10 (T), 7(S) & 9(A)
Nhiệm vụ giớ là lập danh sách 6 (hay hơn) những em đạt điểm như vậy của lớp này. . . Sau đó là đến các lớp khác tương tự

Mong các bạn chớ nản lòng!

 

[ChanhTQ@]

Các bạn làm trên file mới đưa lên ở #46 dùm nha.

http://www.giaiphapexcel.com/forum/showthread.php?93334-Ho%CC%A3c-ca%CC%81ch-lo%CC%A3c-gia%CC%81-tri%CC%A3-l%C6%A1%CC%81n-nh%C3%A2%CC%81t-va%CC%80-nho%CC%89-nh%C3%A2%CC%81t-b%C4%83%CC%80ng-vba!&p=581806

 

[leonguyenz]

Thì bài trên ta biết điểm tối đa của lớp 10A1 là 10(V), 5(L), 6(D), 10 (T), 7(S) & 9(A)
Nhiệm vụ giớ là lập danh sách 6 (hay hơn) những em đạt điểm như vậy của lớp này. . . Sau đó là đến các lớp khác tương tự

Mong các bạn chớ nản lòng!

Dạo này em thấy mấy lần bác viết nhầm, H1 & H2, 10A1 & 12A1, Học viên & Học sinh, ..., Dồn trí lực cho tụi em nhiều quá phải không bác? Cố gắng giữ sức khỏe nha bác!
Bài tập 4 em suy nghĩ đến hàm COUNTIF, phương thức Find, hoặc AdF, ... nhưng sau đó lại chuyển hướng qua vòng lặp và Dic.
[gpecode=vb]
Sub DSachHS()
Dim sArr1(), sArr2(), rArr(), Rng As Range, Dic As Object
Dim i As Long, j As Long, k As Long, l As Long, m As Long
sArr1 = Sheet1.[C7:O699].Value
sArr2 = Sheet2.[B6:H20].Value
ReDim rArr(1 To UBound(sArr1), 1 To 9)
Set Dic = CreateObject("Scripting.Dictionary")
For i = LBound(sArr1) To UBound(sArr1)
For j = LBound(sArr2) To UBound(sArr2)
If sArr1(i, 7) = sArr2(j, 1) Then
For k = 1 To 6
If sArr1(i, k + 7) = sArr2(j, k + 1) Then
If Not Dic.Exists(sArr1(i, 1)) Then
l = l + 1
Dic.Add sArr1(i, 1), l
rArr(l, 1) = l
rArr(l, 2) = sArr1(i, 1)
For m = 1 To 7
rArr(l, m + 2) = sArr2(j, m)
Next m
End If
End If
Next k
End If
Next j
Next i
If l Then
Sheet3.[A6:I1000].Clear
Sheet3.[A6].Resize(l, 9) = rArr
Sheet3.[A6].Resize(l, 9).Borders.LineStyle = 1
End If
Set Dic = Nothing
End Sub
[/gpecode]

 

[SA_DQ]

Bài này làm AdvancedFilter cũng được;
Nhưng danh sách lọc ra xong sẽ có nhiều em trùng (vì học quá giỏi ở cả các môn)
Nên cuối cùng fải tìm cách xử lí những dòng dữ liệu trùng đó.

Còn nếu xài Fương thức FIND() thì công việc cũng fải tìm cách xử chuyện trùng này.

Tất nhiên, áp dụng 2 cách này thì không cần kiến thức VBA cao lắm

 

[phihndhsp]

ĐỀ BÀI 4
​

Dựa vô bảng điểm của bài 3, xin các bạn lập ra danh sách các học viên đạt điểm tối đa hay tối thiểu của khối 12 này.


Trên diễn đàn gần đây có loại bài này rồi; Các bạn có thể tham khảo để có thể làm hay hơn!

Chúc thành công!

Mẫu báo cáo:

DANH SÁCH CÁC EM HOC VIÊN ĐẠT ĐIỂM TỐI ĐA/TỐI THIỂU

TT|HoTen|Lop|Văn|Lí|Địa|Toán|Sinh|Anh
01|Trần Hồ|12A9| 10 |5|6|..| 9| 6
02|Lê La|12A7|4| 8 |7|. . . .|6|5.5
03|Vủ Phu|12A|8| 7.5 |. | . |5|6.5
..|||. . .|..|

Sư phụ test dùm em bài này trường hợp max như vậy có đúng không? em lấy điểm max từng môn sau đó so sánh để lấy tên học sinh cho đúng
hình như bị lặp lại những thằng học giỏi (chắc phải xử lý lại tí nữa)

 

[phihndhsp]

Sư phụ test dùm em bài này trường hợp max như vậy có đúng không? em lấy điểm max từng môn sau đó so sánh để lấy tên học sinh cho đúng
hình như bị lặp lại những thằng học giỏi (chắc phải xử lý lại tí nữa)

Sau khi xử lý xóa trùng sư phụ xem dùm nha, còn trường hợp min thì mình thêm điều kiện chọn lựa nữa là xong

 

[SA_DQ]

Bài đọc thêm

Option Explicit
Sub LapDS()
 Dim Sh0 As Worksheet, Sh1 As Worksheet, Cls As Range, CSDL As Range
 Dim Rws As Long, J As Long, W As Long
 
 Set Sh0 = ThisWorkbook.Worksheets("Sheet1")
 Sheet3.Select
 Rws = Sh0.[j7].CurrentRegion.Rows.Count
 ReDim Arr(1 To Rws, 1 To 7):               ReDim KQ(1 To Rws, 1 To 1)
 Arr() = Sh0.[i7].Resize(Rws, 7).Value
 Set Sh1 = ThisWorkbook.Worksheets("Sheet2")
 For Each Cls In Sh1.Range(Sh1.[B6], Sh1.[B6].End(xlDown))
    For J = 1 To Rws
        For W = 1 To 6
            If Arr(J, 1) = Cls.Value And Arr(J, 1 + W) = Cls.Offset(, W).Value Then
                KQ(J, 1) = "Y":                   Exit For
            End If
        Next W
    Next J
 Next Cls
 Sh0.[d7].Resize(Rws) = KQ()
 Set CSDL = Sh0.[B6].Resize(Rws, 14)
 CSDL.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh0.Range( _
    "Ad1:Ad2"), CopyToRange:=[B6].Resize(, 9), Unique:=False
 Sh0.[d7].Resize(Rws) = ""
End Sub

 

[SA_DQ]

Trong file ở bài #46, tại trang Sheet2 có lời giải bài tập 3 bằng hàm mảng tự tạo để các bạn tham khảo;




Nội dung hàm này cũng đã có ở #34

 

[SA_DQ]

Bài đọc thêm: Lập danh sách các học sinh điểm kém

Option Explicit
Sub DSHocSinhKem()
 Dim Sh As Worksheet
 Dim Rws As Long, J As Long
 
 Set Sh = ThisWorkbook.Worksheets("Sheet1")
 Rws = [I6].CurrentRegion.Rows.Count
 ReDim Arr(1 To Rws, 1 To 6):           ReDim KQ(1 To Rws, 1 To 1)
 Arr() = Sh.[J7].Resize(Rws, 6).Value
 For J = 1 To Rws
    KQ(J, 1) = HSK(Arr(J, 1), Arr(J, 4), Arr(J, 2), Arr(J, 3), Arr(J, 5), Arr(J, 6))
 Next J
 Sh.[D7].Resize(Rws).Value = KQ()
End Sub

[B]
Function HSK(Vn, Tn, Li, Da, Sh, Ah) As String[/B]
 Dim Dm As Byte
 
 If Vn <= 4 Or Tn <= 4 Then
    HSK = "X":                      Exit Function
 Else
    If Li <= 4 Then Dm = Dm + 1
    If Da <= 4 Then Dm = Dm + 1
    If Sh <= 4 Then Dm = Dm + 1
    If Ah <= 4 Then Dm = Dm + 1
 End If
 If Dm > 1 Then HSK = "X"
[B]End Function[/B]

 

[ChanhTQ@]

Bài tập số 5

ĐỀ BÀI 5:
​

Với CSDL đã có, xin các bạn thống kê điểm các môn học theo từng lớp như sau

Tại [H23] của trang 'Sheet2' ta có ô chọn của 6 môn học (Văn,. .. ,Anh)
Khi ta chọn 1 môn nào đó, ta sẽ thu được số liệu báo cáo theo mẫu sau:

TT|Lớp|<=4|<=6|<=8|<=10|Ghi chú
1|12A1|0|5|24|12|
2|12A10|2|6|28|8|
..|||..||.|
15|12A9|2|16|19|8|

Chúc các bạn thành công

 

[VetMini]

Option Explicit
Sub DSHocSinhKem()
 Dim Sh As Worksheet
 Dim Rws As Long, J As Long
 
 Set Sh = ThisWorkbook.Worksheets("Sheet1")
 Rws = [I6].CurrentRegion.Rows.Count
 ReDim Arr(1 To Rws, 1 To 6):           ReDim KQ(1 To Rws, 1 To 1)
 Arr() = Sh.[J7].Resize(Rws, 6).Value
[COLOR=#ff0000] For J = 1 To Rws
    KQ(J, 1) = HSK(Arr(J, 1), Arr(J, 4), Arr(J, 2), Arr(J, 3), Arr(J, 5), Arr(J, 6))
 Next J
[/COLOR] Sh.[D7].Resize(Rws).Value = KQ()
End Sub

[B]
Function HSK(Vn, Tn, Li, Da, Sh, Ah) As String[/B]
 Dim Dm As Byte
 
 If Vn <= 4 Or Tn <= 4 Then
    HSK = "Y":                      Exit Function
 Else
    If Li <= 4 Then Dm = Dm + 1
    If Da <= 4 Then Dm = Dm + 1
    If Sh <= 4 Then Dm = Dm + 1
    If Ah <= 4 Then Dm = Dm + 1
 End If
 If Dm > 1 Then HSK = "Y"
[B]End Function[/B]

Nếu muốn đặt một môn quan trọng hơn các môn khác thì chỉ cần đặt hệ số của nó tăng lên (theo bài này là trên 1)

Dim xetDiem as Integer
For J = 1 To Rws
  KQ(J, 1) = ""
  diemKem = 0
  For J2 = 1 to 6
    diemKem =  diemKem + IIF(Arr(J, J2) > 4, 0, IIF(J2 = 1 Or J2 = 4, 2, 1))
    If diemKem > 1 Then
      KQ(J, 1) = "Y"
      Exit For
    End If
  Next J2
Next J

Thật tình mà nói. Mấy cái bài này tôi nhìn không đơn giản chút nào, và tôi không tin là "người mới bắt đầu" học được cái gì cả.
Tôi chỉ góp 1 vài giải thuật mà tôi cho là có thể cải tiến thôi.

 

[chuot0106]

Nếu muốn đặt một môn quan trọng hơn các môn khác thì chỉ cần đặt hệ số của nó tăng lên (theo bài này là trên 1)

Dim xetDiem as Integer
For J = 1 To Rws
  KQ(J, 1) = ""
  diemKem = 0
  For J2 = 1 to 6
    diemKem =  diemKem + IIF(Arr(J, J2) > 4, 0, IIF(J2 = 1 Or J2 = 4, 2, 1))
    If diemKem > 1 Then
      KQ(J, 1) = "Y"
      Exit For
    End If
  Next J2
Next J

Thật tình mà nói. Mấy cái bài này tôi nhìn không đơn giản chút nào, và tôi không tin là "người mới bắt đầu" học được cái gì cả.
Tôi chỉ góp 1 vài giải thuật mà tôi cho là có thể cải tiến thôi.

Quả thật khi đọc tiêu để topic mấy bài đầu em cũng hồ hởi có tham gia nhưng mấy bài sau này thì buồn không muốn suy nghĩ nữa rồi, vì rất khó, vượt quá sức của mình. Phải nói thật là với những người mới bắt đầu(đúng nghĩa) là quá sức. Vài lời chân thành mong anh ChanhTQ đừng buồn!