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

.
.
.

 

[kuldokk]

Chịu thua không rõ bạn "lười" chỗ nào. Đề bài là "số ngày thứ 6, 13". Cái link bạn đưa ra tìm ngày trong tuần. Trừ phi do tôi dốt tiếng Anh.
Tìm ngày trong tuần chỉ là một bước. Tìm số ngày thứ sau là bước nữa.

Bác chịu thua em thì em cũng xin chịu thua bác 1 phát vì bác nói:

Đại khái là vậy. Nguyên tắc giải bài này nằm ở chỗ sự suy luận về con tính, trái với nguyên tắc VBA là cố gắng dùng những công cụ có sẵn để làm việc.

Đó là lý do tôi đưa câu hỏi này ở đây (hộp bài tập). Bài này chỉ cần hiểu con toán là xong, viết code là vấn đề nhỏ.

Ý của em là suy luận về con tính làm gì?
Ngồi nửa ngày nghĩ ra cái thuật toán để tính được cái ngày hôm ấy là thứ mấy, trong khi tìm kiếm tí là ra, các bậc cha ông vĩ nhân đã làm rồi, giờ con cháu bê về mà áp dụng cho đỡ mất công suy đi tính lại, dành thời gian làm cái gì có ích hơn. Suy luận về con tính làm cái gì khi mà trên bài ở link đã có cách tính rồi. Không dùng hàm có sẵn của VBA thì dùng cách đó.

Tiếng anh thì không bàn tới nên câu đó của bác thừa.
Xin lỗi em nói thẳng ). Cảm ơn bác đã đọc.

 

[Vo Tinh]

Cám ơn Bác SA đã góp ý, hướng dẫn.
Em đang học làm mấy vòng lập thấy bài này có thể áp dụng nên làm luôn
Theo chỉ dẫn em sửa hàm FatherDay lại và sẵn làm luôn hàm MotherDay cho đủ bộ

Hàm FatherDay()

Public Function FatherDay(ByVal yr As Integer)
Dim myDay As Date
If yr < 1900 Then Exit Function
myDay = DateSerial(yr, 6, 22)
FatherDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function

Hàm MotherDay()

Public Function MotherDay(ByVal yr As Integer)
Dim myDay As Date
If yr < 1900 Then Exit Function
myDay = DateSerial(yr, 5, 15)
MotherDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function

 

[ChanhTQ@]

Theo chỉ dẫn em sửa hàm FatherDay lại và sẵn làm luôn hàm MotherDay cho đủ bộ

Bạn có thể tiếp tục gộp 2 hàm này vô 1 không, với việc thêm 1 tham biến tùy chọn "M" hay "C"?

Khà, khà,. . . . & chúc vui nha.

 

[Vo Tinh]

Bạn có thể tiếp tục gộp 2 hàm này vô 1 không, với việc thêm 1 tham biến tùy chọn "M" hay "C"?

Khà, khà,. . . . & chúc vui nha.

Em gộp vào thành ParentDay()

[CODE]
Public Function ParentDay(ByVal yr As Integer, ByVal bL As Boolean)
Dim myDay As Date
If yr < 1900 Then Exit Function   
   Select Case bL   
     Case Is = 1     
        myDay = DateSerial(yr, 6, 22)   
     Case Is = 0     
        myDay = DateSerial(yr, 5, 15)
  End Select
ParentDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function[/CODE]

Không hiểu sau em dùng dòng này thay Select Case mà không được

myDay = DateSerial(yr, 5 + bL, 15 + 7*bL)

 

[ChanhTQ@]

Ở đâu đó thích hợp, bạn thêm dòng lệnh này xem sao

MsgBox bL + 9

Có khi True + 9 = 8 đó nha!

 

[Vo Tinh]

Ở đâu đó thích hợp, bạn thêm dòng lệnh này xem sao

MsgBox bL + 9

Có khi True + 9 = 8 đó nha!

Em cũng đã thử mà thấy sao TRUE = -1 khác với ngoài sheet TRUE =1 nên mới hỏi cho rõ, nếu trong VBA nó như thế thì hàm ParentDay() bỏ thêm phần Select Case

[CODE]

Public Function ParentDay(ByVal yr As Integer, bL As Boolean)
Dim myDay As Date
If yr < 1900 Then Exit Function
myDay = DateSerial(yr, 5 - bL, -(7 * bL) + 15)
ParentDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function

[/CODE]

 

[SA_DQ]

Viểt như vậy là đúng rồi; Nhưng chục năm nữa bạn coi lại sẽ không rõ là những cái gì trong các biểu thức đó!
Là mình thì chân fương thế này:

Public Function ParentDay(ByVal yr As Integer, bL As Boolean)
Dim myDay As Date, Tmp As Byte
If yr < 1900 Then Exit Function
If Bl Then Tmp= 3 Else Tmp = 2
myDay = DateSerial(yr, Tmp + 3, (7 * Tmp + 1))
ParentDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function

 

[VetMini]

Nếu hàm đã viết rồi thì có thể không cần viết lại:

Public Function FatherDay(ByVal yr As Integer)
Dim myDay As Date
If yr < 1900 Then Exit Function
myDay = DateSerial(yr, 6, 22)
FatherDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function

Public Function MotherDay(ByVal yr As Integer)
Dim myDay As Date
If yr &lt; 1900 Then Exit Function
myDay = DateSerial(yr, 5, 15)
MotherDay = Format(myDay - Weekday(myDay - 1), "dd / MM / yyyy")
End Function

Public Function ParentDay(ByVal yr As Integer, ByVal MC As String)
If (MC = "C") Then
ParentDay = FatherDay(yr)
Else
ParentDay = MotherDay(yr)
End If
End Function

Ngược lại nếu viết trọn cái hàm Parent rồi thì nên thêm 2 hàm sau:

Public Function FatherDay(ByVal yr As Integer)
FatherDay = ParentDay(yr, "C")
End Function

Public Function MotherDay(ByVal yr As Integer)
MotherDay = ParentDay(yr, "M")
End Function

@kuldokk:
"...dành thời gian làm cái gì có ích hơn..."
Cái từ "hơn" tự nó đã mang tính chất tương đối và chủ quan. Đối với tôi, chỉ dẫn cho các bạn mới làm quen với lập trình về cách tiến tới giải thuật là có ích rồi, không cần phải "hơn" nữa. Tôi viết bài trong thớt này chỉ với mục đích đó

 

[Van Thai Su]

Có sách nào mọi ng giới thiệu để tìm hiểu về hàm, chứ tôi mù tịt về hàm, mò rất là lâu.

 

[SA_DQ]

Có sách nào mọi ng giới thiệu để tìm hiểu về hàm, chứ tôi mù tịt về hàm, mò rất là lâu.

Nếu là hàm trong VBA thì bạn có thể mở cửa sổ "Help" của VBE lên & tìm hiểu;

Còn hàm tự tạo của ai đó trên GPE.COM thì bí bạn có thể nhờ mọi người diễn dịch sang tiếng Việt

Còn bạn muốn viết hàm thì trước khi viết nên lập sơ đồ khối cho những công việc fức tạp

(Cũng là võ đoán, nếu không trúng mong bạn bỏ qua Chúc những ngày cuối tuần vui vẻ & hạnh phúc!

 

[SA_DQ]

BT: Liệt kê 12 ngày chủ nhật cuối tháng trong 1 năm cụ thể nào đó.

Các bạn tự cho 1 năm nào đó & liệt kê các ngày chủ nhật của đầu hay cuối tháng dùm nha!

Mong được sự hưởng ứng từ các bạn xa gần!

 

[Vo Tinh]

Các bạn tự cho 1 năm nào đó & liệt kê các ngày chủ nhật của đầu hay cuối tháng dùm nha!

Mong được sự hưởng ứng từ các bạn xa gần!

Em xin góp bài tham gia để học

Sub sunDay()
Dim i As Integer, yR As Integer, j As Integer
yR = Val(InputBox("Hay nhap nam can tinh"))
If yR < 1900 Then Exit Sub
[A1].CurrentRegion.ClearContents
For i = 1 To 12
    For j = Day(DateSerial(yR, i + 1, 0)) To Day(DateSerial(yR, i + 1, 0)) - 6 Step -1
        If Weekday(DateSerial(yR, i, j)) = 1 Then
        Cells(i, "B") = DateSerial(yR, i, j)
        End If
    Next j
    For j = 1 To 7
        If Weekday(DateSerial(yR, i, j)) = 1 Then
        Cells(i, "A") = DateSerial(yR, i, j)
        End If
    Next j
Next i
End Sub

 

[ChanhTQ@]

Trong các vòng lặp với biến J, ta nên thoát ngay sau khi đã tìm thấy ngày chủ nhật đầu hay cuối tháng.

Bạn có thể ghi kết quả vô biến mảng gồm 12 hàng & 2 cột.
Cuối cùng ta ghi 1 lần kết quả chứa trong mảng lên trang tính.
Rất cảm ơn bạn đã nhiệt tình tham gia đề tài này!

 

[huuthang_bd]

Em xin góp bài tham gia để học

Sub sunDay()
Dim i As Integer, yR As Integer, j As Integer
yR = Val(InputBox("Hay nhap nam can tinh"))
If yR < 1900 Then Exit Sub
[A1].CurrentRegion.ClearContents
For i = 1 To 12
    For j = Day(DateSerial(yR, i + 1, 0)) To Day(DateSerial(yR, i + 1, 0)) - 6 Step -1
        If Weekday(DateSerial(yR, i, j)) = 1 Then
        Cells(i, "B") = DateSerial(yR, i, j)
        End If
    Next j
    For j = 1 To 7
        If Weekday(DateSerial(yR, i, j)) = 1 Then
        Cells(i, "A") = DateSerial(yR, i, j)
        End If
    Next j
Next i
End Sub

Mạn phép có một vài nhận xét về code của bạn.
1. Đầu tiên là thuật toán. Thuật toán của bạn đúng nhưng chưa hay vì bạn kiểm tra từng ngày. Bạn thử suy nghĩ tiếp xem có cách nào tính thẳng ra ngày CN đầu (hoặc cuối) tháng của mỗi tháng mà không phải kiểm tra từng ngày không?
2. Bạn chưa thoát vòng lặp khi tìm được giá trị cần tìm. Ví dụ ngày đầu tháng là ngày chủ nhật thì đâu cần phải xét tiếp các ngày 2, 3, 4... Bạn có thể lồng thêm lệnh Exit For vào trong cấu trúc If để thoát vòng lặp hoặc dùng cấu trúc Do... Loop Until...
3. Bạn nên hạn chế tối đa số lần gán kết quả xuống sheet hoặc lấy dữ liệu từ sheet để tăng tốc code. Như trong bài này bạn hãy gán kết quả vào một mảng trước sau đó gán xuống sheet 1 lần (mặc dù trường hợp này tốc độ không thay đổi bao nhiêu nhưng bạn hãy tạo thói quen)

 

[ndu96081631]

Em xin góp bài tham gia để học

Sub sunDay()
Dim i As Integer, yR As Integer, j As Integer
yR = Val(InputBox("Hay nhap nam can tinh"))
If yR < 1900 Then Exit Sub
[A1].CurrentRegion.ClearContents
For i = 1 To 12
    For j = Day(DateSerial(yR, i + 1, 0)) To Day(DateSerial(yR, i + 1, 0)) - 6 Step -1
        If Weekday(DateSerial(yR, i, j)) = 1 Then
        Cells(i, "B") = DateSerial(yR, i, j)
        End If
    Next j
    For j = 1 To 7
        If Weekday(DateSerial(yR, i, j)) = 1 Then
        Cells(i, "A") = DateSerial(yR, i, j)
        End If
    Next j
Next i
End Sub

Bài này 1 vòng lập là đủ!
Hãy tham khảo công thức lấy ngày chủ nhật đầu tiên:

=A1 - WEEKDAY(A1,2)+ 7

http://www.giaiphapexcel.com/forum/...-trong-một-quãng-T-G-bất-kỳ&p=16111#post16111
Với A1 là ngày đầu tháng, ta được kết quả là ngày chủ nhật đầu tiên của tháng. Vậy nếu ta trừ kết quả cho 7 thì sẽ có được ngày chủ nhật cuối của tháng trước. Đúng không?

 

[SA_DQ]

Nếu ta lấy viết & bắt đầu lập bảng như sau:

Nếu ngày đầu tháng là chủ nhật (CN) thì đó là ngày CN đầu tháng;
Nếu ngày đầu tháng là thứ Hai => Ngày CN đầu tháng đó là ngày 7 (của tháng)
-------------------------------- Ba => ------------------------------------6
-------------------------------- Tư => ------------------------------------5
------------------------------ Năm => ------------------------------------4
--------------------------------Sáu => ------------------------------------3
--------------------------------Bảy => ------------------------------------2

Một khi đã lập ra bảng này, ta có thể không xài vòng lặp nữa, được không các bạn!?!

 

[Vo Tinh]

=A1 - WEEKDAY(A1,2)+ 7

Với A1 là ngày đầu tháng, ta được kết quả là ngày chủ nhật đầu tiên của tháng. Vậy nếu ta trừ kết quả cho 7 thì sẽ có được ngày chủ nhật cuối của tháng trước. Đúng không?

Rất cám ơn Bác SA và 2 Anh đã góp ý và chia sẻ, em làm lại theo công thức gợi ý của Anh Tuấn (lần trước Bác SA đã chỉ rồi mà quên mất tiêu )

Sub sunDayW()
Dim i As Integer, yR As Integer, firstDayOfMonth As Date, firstDayOfNextMonth As Date, dArr
yR = Val(InputBox("Hay nhap Nam can tinh"))
If yR < 1900 Then Exit Sub
[A1].CurrentRegion.ClearContents
ReDim dArr(1 To 12, 2)
    For i = 1 To 12
        firstDayOfMonth = DateSerial(yR, i, 1): firstDayOfNextMonth = DateSerial(yR, i + 1, 1)
        dArr(i, 0) = firstDayOfMonth - Weekday(firstDayOfMonth, 2) + 7
        dArr(i, 1) = firstDayOfNextMonth - Weekday(firstDayOfNextMonth, 2)
    Next i
Range("A1:B12") = dArr
End Sub

 

[Hau151978]

Em xin nộp bài

Sub XXX()
'Sub ghi cac ngay CN dau va cuoi thang vao A2:B13, A1 la so nam
    Dim y&, i&, d&, arr()
    y = [A1]
    ReDim arr(1 To 13, 1 To 2)
    d = Weekday(DateSerial(y, 1, 1))
    arr(1, 1) = IIf(d = 1, DateSerial(y, 1, 1), DateSerial(y, 1, 9 - d))
    For i = 1 To 12
        arr(i, 2) = IIf(Day(arr(i, 1) + 28) > 7, arr(i, 1) + 28, arr(i, 1) + 21)
        arr(i + 1, 1) = arr(i, 2) + 7
    Next
    Range("A2:B13") = arr
End Sub

 

[Hau151978]

Code không dùng vòng lặp

Sub ABC()
    Range("A2").Formula = "=IF(WEEKDAY(DATE($A$1,ROW(1:1),1))=1,DATE($A$1,ROW(1:1),1),DATE($A$1,ROW(1:1),9-WEEKDAY(DATE($A$1,ROW(1:1),1))))"
    Range("A2:A13").FillDown
    Range("B2").Formula = "=A3-7"
    Range("B2:B12").FillDown
    [B13] = IIf(Day([A13]) < 4, [A13] + 28, [A13] + 21)
    Range("A2:B13").Copy
    Range("A2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

 

[Vo Tinh]

Code không dùng vòng lặp

Sub ABC()
    Range("A2").Formula = "=IF(WEEKDAY(DATE($A$1,ROW(1:1),1))=1,DATE($A$1,ROW(1:1),1),DATE($A$1,ROW(1:1),9-WEEKDAY(DATE($A$1,ROW(1:1),1))))"
    Range("A2:A13").FillDown
    Range("B2").Formula = "=A3-7"
    Range("B2:B12").FillDown
    [B13] = IIf(Day([A13]) < 4, [A13] + 28, [A13] + 21)
    Range("A2:B13").Copy
    Range("A2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Cái này giống "ăn gian" xài công thức ngoài sheet roài
Với A1 là Năm cần tính

Sub sunDayWWW()
  [A2].CurrentRegion.Offset(1).ClearContents
     Cells(2, 1).Formula = "=Date($A$1, rows($1:1), 1) - Weekday(Date($A$1, rows($1:1), 1), 2) + 7"
     Cells(2, 2).Formula = "=Date($A$1, rows($1:2), 1) - Weekday(Date($A$1, rows($1:2), 1), 2)"
  Range("A2:B13").FillDown
  Range("A2:B13").Value = Range("A2:B13").Value
End Sub