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

Liên hệ QC
ChanhTQ@

ChanhTQ@

0901452không62
Tham gia
5/9/08
Bài viết
4,256
Được thích
4,863
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

.
.
.
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
leonguyenz đã viết:
Đ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*).
Nhấp chuột vào đây để mở rộng...
Vậy cách khắc phục như thế nào đây anh. Áp dụng với code của em ạ???
 
Upvote 0
chuot0106 đã viết:
Vậy cách khắc phục như thế nào đây anh. Áp dụng với code của em ạ???
Nhấp chuột vào đây để mở rộng...
Đã 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.
 
Upvote 0
leonguyenz đã viết:
Đã 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.
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
chuot0106 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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ả:
Mã: 
="12A"&TEXT(MID(A1,4,2),"00")
Kết quả trong file của bạn.
 

File đính kèm

  • Baigiai_chuot0106_1.xls
    239 KB · Đọc: 12
Upvote 0
Đọ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:

PHP: 
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
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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
..|--=0||. . .|..|
 

File đính kèm

  • gpeBaiTap.rar
    48.8 KB · Đọc: 36
Lần chỉnh sửa cuối:
Upvote 0
ChanhTQ@ đã viết:
ĐỀ 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
..|--=0||. . .|..|
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
phihndhsp đã viết:
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ồ
Nhấp chuột vào đây để mở rộng...
Em cũng chung băn khoăn với anh.
 
Upvote 0
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!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
HYen17 đã viết:
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!
Nhấp chuột vào đây để mở rộ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]
 

File đính kèm

  • MinIf4.xls
    289.5 KB · Đọc: 31
Upvote 0
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
 
Upvote 0
ChanhTQ@ đã viết:
ĐỀ 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
..|--=0||. . .|..|
Nhấp chuột vào đây để mở rộng...
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)
 

File đính kèm

  • MinIf3.rar
    60 KB · Đọc: 18
Lần chỉnh sửa cuối:
Upvote 0
phihndhsp đã viết:
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)
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • MinIf4.rar
    60.1 KB · Đọc: 17
Upvote 0
Bài đọc thêm

PHP: 
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
 
Lần chỉnh sửa cuối:
Upvote 0
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


--=0 --=0 --=0
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Bài đọc thêm: Lập danh sách các học sinh điểm kém

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

--=0--=0--=0--=0


Mã: 
[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]
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
SA_DQ đã viết:
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
[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

Mã: 
[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]
Nhấp chuột vào đây để mở rộng...

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)

Mã: 
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.
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
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)

Mã: 
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.
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

dunghtgiga
Không cho người khác chỉnh sửa nội dung bảng tính
Trả lời
4
Đọc
107
VetMini
V
H
Tính tổng có điều kiện
Trả lời
18
Đọc
284
VetMini
V
vova2209
Hàm if điều kiện mảng
Trả lời
18
Đọc
335
VetMini
V
T
Thống kê ngày hết hạn của sản phẩm
Trả lời
12
Đọc
241
VetMini
V
T
tự động giãn dòng theo dữ liệu
    • Buồn
Trả lời
3
Đọc
63
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom