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

ChanhTQ@ · 29/5/14

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:

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

.
.
.

phihndhsp · 6/6/14

ChanhTQ@ đã viết:
ĐỀ 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

Nhờ sư phụ chỉnh lại không biết sai ở đâu. Trong file tách ra từng điều kiện thì ok.
Nhưng code bên dưới muốn gộp lại thì lại bị lỗi. mong sư phụ chỉnh code bên dưới cho đúng kết quả như trong file

Sub DATA_THONGKE()

Dim rngs(), rngs2(), ARR(), I As Long, J As Long, K As Long, M As Long, L As Long
On Error Resume Next
Dim TAM As Double
Dim SODUOI As Double

With Sheet1
rngs = .Range(.[A7], .[A60000].End(xlUp)).Resize(, 20).Value
End With
With Sheet2
rngs2 = .Range(.[A7], .[A60000].End(xlUp)).Resize(, 20).Value
End With

'''''''''''TIM VI TRI THONG KE
'''''''''''K LA VI TRI CAN THONG KE
For K = 1 To 15
If (Sheet2.Cells(2, 8).Value = Sheet1.Cells(6, K).Value) Then
Exit For
End If
Next

ReDim ARR(1 To UBound(rngs2, 1), 1 To 4)

For I = 1 To UBound(rngs2, 1)
SODUOI = 0
For L = 4 To 10 Step 2
TAM = 0
M = 1
For J = 1 To UBound(rngs, 1)
If (rngs2(I, 2) = rngs(J, 8)) Then
If (rngs(J, K) <= L And rngs(J, K) > SODUOI) Then
TAM = TAM + 1
End If
End If
Next J
ARR(I, M) = TAM
SODUOI = L
M = M + 1
Next L
Next I

Sheet2.Range("C7").Resize(I, 4).Value = ARR
End Sub

SA_DQ · 6/6/14

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!

Thật ra mà nói, mấy bài này ta có thể xài vòng lặp, kiến thức về fương thức lọc dữ liệu bằng AdvancedFilter là có thể làm ra được hết; chỉ có điều sẽ tốn chi fí điện nước mà thôi;

Một số bài giải/bài đọc thêm có xài biến mảng; Nhưng nếu ta xài vòng lặp duyệt toàn bộ các dòng dữ liệu thay cho công cụ đó cũng xong ngay thôi.

Còn bài thống kê gần đây nhất, ta tiến xa hơn 1 bước với AdvancedFilter là sang các hàm CSDL.
Vế hàm CSDL là thế mạnh rất nhiều, khi người ta chưa biết về biến mảng, Dic. & cách làm việc với chúng nó.

Mình cũng chưa đồng í với 1 số bạn trong topic này ở chỗ: Mình có kiến thức (KT) gì thì đưa ra xử BT kiến thức ấy; Mà chưa dùng KT tối thiểu của mình để giải quyết 1 bài toán nhằm đến 'Người mới bắt đầu'! Có vậy mới đúng tiêu chí của đề tài topic.

Những bạn trả lời 'Xa xôi' chúng ta coi như là những tham khảo mà thôi!

Vài lời để mong mọi người có bài trong topic này hiểu thêm & thông cảm!

Mình cho rằng, những người tham gia giải BT đã là tốt, nhưng cái tốt hơn đem lại là rất nhiều người quan tâm & truy nhập vô topic.
Mình rất cảm ơn về điều đó!

chuot0106 · 6/6/14

SA_DQ đã viết:
Thật ra mà nói, mấy bài này ta có thể xài vòng lặp, kiến thức về fương thức lọc dữ liệu bằng AdvancedFilter là có thể làm ra được hết; chỉ có điều sẽ tốn chi fí điện nước mà thôi;

Một số bài giải/bài đọc thêm có xài biến mảng; Nhưng nếu ta xài vòng lặp duyệt toàn bộ các dòng dữ liệu thay cho công cụ đó cũng xong ngay thôi.

Còn bài thống kê gần đây nhất, ta tiến xa hơn 1 bước với AdvancedFilter là sang các hàm CSDL.
Vế hàm CSDL là thế mạnh rất nhiều, khi người ta chưa biết về biến mảng, Dic. & cách làm việc với chúng nó.

Mình cũng chưa đồng í với 1 số bạn trong topic này ở chỗ: Mình có kiến thức (KT) gì thì đưa ra xử BT kiến thức ấy; Mà chưa dùng KT tối thiểu của mình để giải quyết 1 bài toán nhằm đến 'Người mới bắt đầu'! Có vậy mới đúng tiêu chí của đề tài topic.

Những bạn trả lời 'Xa xôi' chúng ta coi như là những tham khảo mà thôi!

Vài lời để mong mọi người có bài trong topic này hiểu thêm & thông cảm!

Mình cho rằng, những người tham gia giải BT đã là tốt, nhưng cái tốt hơn đem lại là rất nhiều người quan tâm & truy nhập vô topic.
Mình rất cảm ơn về điều đó!

Quả thật là lúc trước em cũng có góp ý với chủ topic là với mỗi 1 bài tập sau 1 thời gian nào đó nên đưa lời giải (Giành cho người mới bắt đầu) để bọn em tham khảo và đối chiếu. Tuy nhiên không thấy chủ topic đưa ra. Cũng có 1 vài bài tham khảo(bài đọc thêm) tuy nhiên không phải của chủ topic.

leonguyenz · 6/6/14

Xem như đã có khung Stt và Lớp, H2 dùng Data Validation để chọn môn học.
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, i As Long, j As Long, k As Long, Kq As Long
Set Rng = Sheet1.Range("I6:O699")
If Not Intersect(Target, [H2]) Is Nothing Then
Range("C6:F20").ClearContents
For i = 1 To Rng.Rows.Count
For j = 6 To 20
If Rng(i, 1) = Cells(j, 2) Then
For k = 2 To 7
If Rng(1, k) = Target Then
Select Case Rng(i, k)
Case 0 To 4: Cells(j, 3) = Cells(j, 3) + 1
Case 4 To 6: Cells(j, 4) = Cells(j, 4) + 1
Case 6 To 8: Cells(j, 5) = Cells(j, 5) + 1
Case 8 To 10: Cells(j, 6) = Cells(j, 6) + 1
End Select
End If
Next k
End If
Next j
Next i
End If
End Sub
[/gpecode]

SA_DQ · 6/6/14

Xem như đã có khung Stt và Lớp, H2 dùng Data Validation để chọn môn học.

Trong CSDL hiện chì có loại điểm >=0;

Nhưng liêu trong bảng điểm thay vì như 6.75 người ta chấm -7; (Có nghĩa chỉ có các loại điểm trong sổ dang 6, 6.5 -7 & 7,. . .) thì macro của Thảo fải sửa thế nào nhỉ?

leonguyenz · 6/6/14

HYen17 đã viết:
Trong CSDL hiện chì có loại điểm >=0;

Nhưng liêu trong bảng điểm thay vì như 6.75 người ta chấm -7; (Có nghĩa chỉ có các loại điểm trong sổ dang 6, 6.5 -7 & 7,. . .) thì macro của Thảo fải sửa thế nào nhỉ?

Có thể thêm hàm ABS chỗ Select Case như vậy được không bác?
[gpecode=vb]Select Case Abs(Rng(i, k))[/gpecode]

SA_DQ · 6/6/14

Ta có thể xài DCOUNTA() để khỏi duyệt toàn bộ gần 700 em HS, tuy nhiên

Cần có 1 số thiết kế sẵn để fục vụ macro sự kiện này tại Sheet2.[H23]:

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, CSDL As Range, Cls As Range, WF As Object
 Dim Rws As Long, J As Long, Min_ As Double, Max_ As Double, Tmr As Double
  
 If Not Intersect(Target, [H23]) Is Nothing Then
    Tmr = Timer()
    Set WF = Application.WorksheetFunction
    Set Sh = ThisWorkbook.Worksheets("Sheet1")
    Rws = Sh.[i6].CurrentRegion.Rows.Count
    Set CSDL = Sh.[i6].Resize(Rws, 7)
    For Each Cls In Range([B26], [B26].End(xlDown))
7        Sh.[AA4].Value = Cls.Value
8        Sh.[AB1:AC1].Value = Target.Value
        For J = 1 To 4
            Min_ = Choose(J, -1, 4, 6, 8)
            Max_ = Choose(J, 4, 6, 8, 10)
9            Sh.[ab4].Value = Min_:          Sh.[ac4].Value = Max_
            Cls.Offset(, J).Value = WF.DCountA(CSDL, Sh.[i6], Sh.[aa1:ac2])
        Next J
    Next Cls
    MsgBox Timer() - Tmr
 End If
End Sub

Các bạn chú í các dòng lệnh có đánh số vì chúng có liên quan với thiết kế tại trang Sheet1; 1 fần của trang đó có liên quan đến các donh lệnh này được mô tả như sau:

| AA | AB | AC 1 |=I6||
2 |="=" & AA4|=">"&AB4|="<="&AC4
3 || }}}}}

|

SA_DQ · 7/6/14

Mình xin đố các bạn, là

Ta có thể xài DCOUNTA() để khỏi duyệt toàn bộ gần 700 em HS, tuy nhiên

Tại sao trong bài, tác giả xài DCOUNTA() mà không xài DCOUNT()?

phihndhsp · 7/6/14

phihndhsp đã viết:
Nhờ sư phụ chỉnh lại không biết sai ở đâu. Trong file tách ra từng điều kiện thì ok.
Nhưng code bên dưới muốn gộp lại thì lại bị lỗi. mong sư phụ chỉnh code bên dưới cho đúng kết quả như trong file

Tạm thời sửa như thế này. nhưng vẫn muốn sử dụng vòng lập cho hàng ngang, không muốn sử dụng if hoặc case vì nếu bài này nhiều trường hợp sảy ra thì if và case sẽ không ứng dụng tối ưu được

Sub DATA_THONGKE()

Dim rngs(), rngs2(), ARR(), I As Long, J As Long, K As Long, M As Long, L As Long
On Error Resume Next
Dim TAM As Double
Dim SODUOI As Double
Sheet2.Range("C7:H200").ClearContents
With Sheet1
rngs = .Range(.[A7], .[A60000].End(xlUp)).Resize(, 20).Value
End With
With Sheet2
rngs2 = .Range(.[A7], .[A60000].End(xlUp)).Resize(, 20).Value
End With

'''''''''''TIM VI TRI THONG KE
'''''''''''K LA VI TRI CAN THONG KE
For K = 1 To 15
If (Sheet2.Cells(2, 8).Value = Sheet1.Cells(6, K).Value) Then
Exit For
End If
Next

ReDim ARR(1 To UBound(rngs2, 1), 1 To 4)

For I = 1 To UBound(rngs2, 1)
For J = 1 To UBound(rngs, 1)
If (rngs2(I, 2) = rngs(J, 8)) Then
If (rngs(J, K) <= 4) Then
Sheet2.Cells(I + 6, 3) = Sheet2.Cells(I + 6, 3) + 1
End If

If (rngs(J, K) <= 6 And rngs(J, K) > 4) Then
Sheet2.Cells(I + 6, 4) = Sheet2.Cells(I + 6, 4) + 1
End If

If (rngs(J, K) <= 8 And rngs(J, K) > 6) Then
Sheet2.Cells(I + 6, 5) = Sheet2.Cells(I + 6, 5) + 1
End If

If (rngs(J, K) > 8) Then
Sheet2.Cells(I + 6, 6) = Sheet2.Cells(I + 6, 6) + 1
End If
End If
Next J

Next I
End Sub

nhưng tại sao sử dụng vòng for thì gán dữ liệu vào nó không hợp lý, sư phụ có thể sử dụng code này sử dụng for sau đó gán dữ liệu dùm em xem học hỏi được không

phihndhsp · 7/6/14

phihndhsp đã viết:
Tạm thời sửa như thế này. nhưng vẫn muốn sử dụng vòng lập cho hàng ngang, không muốn sử dụng if hoặc case vì nếu bài này nhiều trường hợp sảy ra thì if và case sẽ không ứng dụng tối ưu được

nhưng tại sao sử dụng vòng for thì gán dữ liệu vào nó không hợp lý, sư phụ có thể sử dụng code này sử dụng for sau đó gán dữ liệu dùm em xem học hỏi được không

Mới làm được rồi, ngày hôm qua cũng làm như vậy mà sao không ra kết quả hôm nay tự nhiên lại ra

Sub DATA_THONGKE()

Dim rngs(), rngs2(), ARR(), I As Long, J As Long, K As Long, M As Long, L As Long
On Error Resume Next
Dim TAM As Double
Dim SODUOI As Double
Sheet2.Range("C7:H200").ClearContents
With Sheet1
rngs = .Range(.[A7], .[A60000].End(xlUp)).Resize(, 20).Value
End With
With Sheet2
rngs2 = .Range(.[A7], .[A60000].End(xlUp)).Resize(, 20).Value
End With

'''''''''''TIM VI TRI THONG KE
'''''''''''K LA VI TRI CAN THONG KE
For K = 1 To 15
If (Sheet2.Cells(2, 8).Value = Sheet1.Cells(6, K).Value) Then
Exit For
End If
Next

ReDim ARR(1 To UBound(rngs2, 1), 1 To 4)

For I = 1 To UBound(rngs2, 1)
For J = 1 To UBound(rngs, 1)
If (rngs2(I, 2) = rngs(J, 8)) Then

SODUOI = 0
TAM = 2
For L = 4 To 10 Step 2
TAM = TAM + 1
If (rngs(J, K) <= L And rngs(J, K) > SODUOI) Then
Sheet2.Cells(I + 6, TAM) = Sheet2.Cells(I + 6, TAM) + 1
End If
SODUOI = L
Next L
End If
Next J

Next I
End Sub

ChanhTQ@ · 7/6/14

Bài tập 6: TÍNH ĐIỂM TRUNG BÌNH MÔN HỌC THEO FÁI TÍNH.

Đề bài tập

Với CSDL như trong file của bài 46, chúng ta hoàn toàn có khả năng thông kê số liệu theo bảng sau đây:

|| Văn | Văn |Lí|Lí| Địa | Địa |Toán|Toán| Sinh | Sinh |Anh|Anh| Ghi chú
TT|Lớp|Nam|Nữ| Nam|Nữ| Nam|Nữ| Nam|Nữ| Nam|Nữ| Nam|Nữ|
01|10A1|7.51|7.53|7.46|7.47|7.40|7.42|6.48|6.51|6.42|6.48|5.65|5.55|
.|..|.|.|.|.|.|.|.|.|.|.|.|.|
0?|12A1?|7.10|7.43|7.6|7.7|7.49|7.2|6.8|6.1|6.2|6.8|5.6|5.5|
08|12A2|7.31|7.31|7.24|7.24|7.27|7.27|6.34|6.34|6.32|6.32|6.08|6.08|
.|..|.|.|.|.|.|.|.|.|.|.|.|.| --=0

15|12A9|6.62|6.59|6.56|6.75|6.66|6.79|5.73|5.85|5.70|5.79|5.89|5.89|

Xin mời các bạn gần xa thử sức.

SA_DQ · 10/6/14

Các bạn tham khảo 1 trong những cách giải bài tập cuối.

PHP:

Option Explicit
Sub DiemBQTheoFaiTinh()
 Dim Sh As Worksheet, CSDL As Range, Cls As Range, WF As Object
 Dim Rws As Long, J As Byte, W As Byte, Tmr As Double
 
 Tmr = Timer():                                     Set Sh = ThisWorkbook.Worksheets("Sheet1")
 Rws = Sh.[e6].CurrentRegion.Rows.Count
 Set CSDL = Sh.[e6].Resize(Rws, 11)
 Set WF = Application.WorksheetFunction
 For Each Cls In Range([b51], [b51].End(xlDown))
    Sh.[aa4].Value = Cls.Value
    For J = 1 To 6
        For W = 1 To 2
            Sh.[Z2].Value = Choose(W, "", 1)
            Cls.Offset(, 2 * J - (W Mod 2)).Value = WF.DAverage(CSDL, Sh.[I6].Offset(, J), Sh.[z1:aa2])
        Next W
    Next J
 Next Cls
 [o48].Value = Timer() - Tmr
End Sub

SA_DQ · 11/6/14

Bài tập 1A: Chọn ra những số theo yêu cầu từ các chuỗi số

ĐỀ BÀI TẬP 1A:

.
.

Mình có các chuỗi số liệu tại cột [A].
Muốn có mácro để từ các chuỗi số đó xử lí & lọc ra các số gồm 32, 33 & 34. Sau đó thể hiện lên cột [C] như bảng dưới đây:

A || C || E
Các số||Kết quả mong muốn||Mong muốn nâng cao
0123,28,29,26,25,332,833,34,52,48,47,57,59,61,64,65||34||34
33,40,34,32,50,86,99||32,33,34|| 33,34,32
09,20,32,33,34,38,40||32,33,34||32,33,34
33,59,60||33||33
32,20,33,34||32,33,34||32,33,34
33||33||33
42||||
32||32||32
01,02,340,05,06,07||||
10,11,12,13,14,15,32||32||32
333334233||||
3,4,2,6||||

leonguyenz · 11/6/14

Code này chạy thì ok rồi, nhưng chắc là chưa đúng ý của bác:
[gpecode=vb]
Sub Button1_Click()
Dim Rng As Range, Cell As Range, TmpArr As Variant, i As Long, Tmp As String
Set Rng = Sheet1.Range("A2:A13")
For Each Cell In Rng
If IsNumeric(Cell) And (Cell = 32 Or Cell = 33 Or Cell = 34) Then
Cell.Offset(, 2) = Cell
Else
Tmp = Cell.Offset(, 2)
TmpArr = Split(Cell, ",")
For i = 0 To UBound(TmpArr)
If TmpArr(i) = 32 Or TmpArr(i) = 33 Or TmpArr(i) = 34 Then
Tmp = Tmp & "," & TmpArr(i)
End If
Next i
If Len(Tmp) Then Cell.Offset(, 2) = Right(Tmp, Len(Tmp) - 1)
End If
Next Cell
End Sub
[/gpecode]

ndu96081631 · 11/6/14

leonguyenz đã viết:
Code này chạy thì ok rồi, nhưng chắc là chưa đúng ý của bác:

Dùng InStr để tìm cho nó lẹ ---> giống như hàm Find và Search trên bảng tính ấy. Một vòng lập là được

leonguyenz · 11/6/14

ndu96081631 đã viết:
Dùng InStr để tìm cho nó lẹ ---> giống như hàm Find và Search trên bảng tính ấy. Một vòng lập là được

Nếu dùng InStr thì: 01,02,340,05,06,07 và 333334233

sẽ trích ra ký tự, chưa đúng với yêu cầu bài toán.

ndu96081631 · 11/6/14

leonguyenz đã viết:
Nếu dùng InStr thì: 01,02,340,05,06,07 và 333334233
sẽ trích ra ký tự, chưa đúng với yêu cầu bài toán.

Thì... tự suy nghĩ thêm đi! Sao lại không được chứ?

SA_DQ · 11/6/14

Mình mới sửa đáp án ở dòng có con số 42 & xin lỗi các bạn về việc này!

Bài này cũng như fần nâng cao ta có thể viết hàm tự tạo.

leonguyenz · 12/6/14

ndu96081631 đã viết:
Thì... tự suy nghĩ thêm đi! Sao lại không được chứ?

HYen17 đã viết:
Mình mới sửa đáp án ở dòng có con số 42 & xin lỗi các bạn về việc này!
Bài này cũng như fần nâng cao ta có thể viết hàm tự tạo.

Nếu không có dòng màu cam thì em vẫn nghĩ là không được. Có thể là còn nhiều cách dùng khác, nhưng em chỉ nghĩ được vậy thôi.
[gpecode=vb]
Public Function Trich(Cell As Range, a As Long, _
b As Long, c As Long)
Dim Tmp As String
If Cell = a Or Cell = b Or Cell = c Then
Tmp = Cell
Else
If InStr(1, "," & Cell & ",", "," & a & ",") Then _
Tmp = Tmp & "," & a
If InStr(1, "," & Cell & ",", "," & b & ",") Then _
Tmp = Tmp & "," & b
If InStr(1, "," & Cell & ",", "," & c & ",") Then _
Tmp = Tmp & "," & c
If Len(Tmp) Then Tmp = Right(Tmp, Len(Tmp) - 1)
End If
Trich = Tmp
End Function
[/gpecode]

ndu96081631 · 12/6/14

leonguyenz đã viết:
Nếu không có dòng màu cam thì em vẫn nghĩ là không được. Có thể là còn nhiều cách dùng khác, nhưng em chỉ nghĩ được vậy thôi.

Thay dấu "," bằng khoảng trắng sẽ hay hơn
(và có thể lợi dụng thằng WorksheetFunction.Trim để "mần")

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

0901452không62

Thành viên gạo cội

File đính kèm

/(hông là gì!

Thành viên gắn bó

Thành viên gạo cội

File đính kèm

/(hông là gì!

Thành viên gạo cội

/(hông là gì!

/(hông là gì!

Thành viên gạo cội

Thành viên gạo cội

0901452không62

/(hông là gì!

File đính kèm

/(hông là gì!

Thành viên gạo cội

Huyền thoại GPE

Thành viên gạo cội

Huyền thoại GPE

/(hông là gì!

Thành viên gạo cội

File đính kèm

Huyền thoại GPE