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

[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

 

[Hau151978]

Không xài công thức + không dùng vòng lặp thì khó lắm, hay viết các lệnh 12 lần?

 

[SA_DQ]

Bài tập: Tìm cách xài lại lịch 6 tờ của năm 1999

Mình có 6 tờ lịch thật đẹp & có giá trị cao gồm 12 tháng của năm 1.999 (nhưng không có đề năm)

Mình muốn tính xem năm nào sau đó có thể xài lại tờ lịch này.

Bạn nào giúp mình với nha & xin cảm ơn trước!

 

[Hoàng Trọng Nghĩa]

Mình có 6 tờ lịch thật đẹp & có giá trị cao gồm 12 tháng của năm 1.999 (nhưng không có đề năm)

Mình muốn tính xem năm nào sau đó có thể xài lại tờ lịch này.

Bạn nào giúp mình với nha & xin cảm ơn trước!

Sao mà trùng khớp hết được bác? Nào là THỨ phải giống nhau, nào là ngày 28 hoặc 29 của tháng 2.

 

[Hoàng Trọng Nghĩa]

Mình có 6 tờ lịch thật đẹp & có giá trị cao gồm 12 tháng của năm 1.999 (nhưng không có đề năm)

Mình muốn tính xem năm nào sau đó có thể xài lại tờ lịch này.

Bạn nào giúp mình với nha & xin cảm ơn trước!

Hic, ngồi làm thủ công vì chả có quy tắc gì để tính, thì thấy các năm có thứ, ngày, tháng giống nhau như đúc, đó là các năm: 2010 (đã qua), 2021, 2038, 2049, 2066, 2077, ... (tính tới đây thôi, không biết có sống thêm được nữa không).

 

[Hau151978]

Mình có 6 tờ lịch thật đẹp & có giá trị cao gồm 12 tháng của năm 1.999 (nhưng không có đề năm)

Mình muốn tính xem năm nào sau đó có thể xài lại tờ lịch này.

Bạn nào giúp mình với nha & xin cảm ơn trước!

Em chỉ xét đến năm 2099, chắc sau đó tờ lịch đó cũng hỏng rồi.

Sub Lich()
    Dim n&, d&, i&, arr()
    ReDim arr(1 To 100, 1 To 1)
    arr(1, 1) = 1999
    i = 1
    For n = 2000 To 2099
        d = d + IIf(n Mod 4 = 1, 2, 1)
        If (n Mod 4 <> 0) And (d Mod 7 = 0) Then
            i = i + 1
            arr(i, 1) = n
        End If
    Next
    Range("A1:A" & i) = arr
End Sub

 

[Hau151978]

Hic, ngồi làm thủ công vì chả có quy tắc gì để tính, thì thấy các năm có thứ, ngày, tháng giống nhau như đúc, đó là các năm: 2010 (đã qua), 2021, 2038, 2049, 2066, 2077, ... (tính tới đây thôi, không biết có sống thêm được nữa không).

Quy tắc cũng là cách bác làm thủ công đó:tìm những năm không nhuận có ngày 1/1 là thứ 6 giống năm 1999.

 

[SA_DQ]

Quy tắc cũng là cách bác làm thủ công đó:tìm những năm không nhuận có ngày 1/1 là thứ 6 giống năm 1999.

(*) Ai lại đi móm cung cho chàng Nghĩa này bao giờ kia chứ!

(**) Cũng có cách khác để không qua bước tra cứu 'Năm Nhuận hay không'

 

[Hau151978]

Nếu không tra cứu năm nhuận thì phải dùng hàm weekday, tra trong 100 năm lại gọi 100 lần hàm đó, tốc độ sẽ chậm hơn.

 

[doveandrose]

các bậc cha chú bàn chuyện cũng tếu nhỉ . nhưng theo ngu kiến của em , dựa vào bạn tính ở bài #225 thì thầy HYen17 vui lòng đợi thêm ...404 năm nữa để xài lại tờ lịch =))
vì năm 1999 là năm Kỉ Mão . theo cách tính của bạn Hau151978 thì phải đến năm 2419 mới là năm Kỉ Mão và có thứ ngày trùng khớp với năm 1999
và khi đó các thông số tử vi trên tờ lịch theo từng ngày mới chính xác được

 

[Hau151978]

các bậc cha chú bàn chuyện cũng tếu nhỉ . nhưng theo ngu kiến của em , dựa vào bạn tính ở bài #225 thì thầy HYen17 vui lòng đợi thêm ...404 năm nữa để xài lại tờ lịch =))
vì năm 1999 là năm Kỉ Mão . theo cách tính của bạn Hau151978 thì phải đến năm 2419 mới là năm Kỉ Mão và có thứ ngày trùng khớp với năm 1999
và khi đó các thông số tử vi trên tờ lịch theo từng ngày mới chính xác được

Mình không xét năm âm lịch, năm âm lịch theo can chi thì 60 năm lặp lại nhưng còn năm nhuận âm lịch thì bó tay.
Mình chỉ xét dương lịch đến năm 2099, từ 2100 trở đi thì cách tính khác.

 

[SA_DQ]

Nếu không tra cứu năm nhuận thì phải dùng hàm weekday, tra trong 100 năm lại gọi 100 lần hàm đó, tốc độ sẽ chậm hơn.

Nếu coi ngày nào đó là 1 điểm, thì tuần nào đó là 3 điểm, còn tháng sẽ là đường (đa số là thẳng, có vài đoạn cong) & năm sẽ là mặt fẵng.
Mà theo định đề thì qua 2 điểm ta có thể kẻ được 1 đường thẳng.
Chỉ có điều điểm thứ 2 sẽ fải từ 1/3 trở đi mà thôi.

Các bác bàn chuyện cũng tếu nhỉ . nhưng theo ngu kiến của em , dựa vào bạn tính ở bài #225 thì thầy HYen17 vui lòng đợi thêm ...404 năm nữa để xài lại tờ lịch =))
vì năm 1999 là năm Kỉ Mão . theo cách tính của bạn Hau151978 thì phải đến năm 2419 mới là năm Kỉ Mão và có thứ ngày trùng khớp với năm 1999
và khi đó các thông số tử vi trên tờ lịch theo từng ngày mới chính xác được

Ừ nhỉ, vậy thêm điều kiện không chơi lịch âm mới còn đem ra xài được (ví như lịch sản xuất tại fương trời Âu-Mĩ vậy!).

Mà lịch này chỉ là 6 tờ thôi đó nha, không fải >=365 tờ đâu!

 

[Hau151978]

Nếu coi ngày nào đó là 1 điểm, thì tuần nào đó là 3 điểm, còn tháng sẽ là đường (đa số là thẳng, có vài đoạn cong) & năm sẽ là mặt fẵng.
Mà theo định đề thì qua 2 điểm ta có thể kẻ được 1 đường thẳng.
Chỉ có điều điểm thứ 2 sẽ fải từ 1/3 trở đi mà thôi.

Vậy là bác so sánh weekday(dateserial(n,1,1)) và weekday(dateserial(n,3,1)) với weekday(dateserial(1999,1,1)) và weekday(dateserial(1999,3,1)). Nếu vậy thì cần dùng hàm weekday 200 lần trong vòng 100 năm.
Thực ra nếu weekday(dateserial(n+1,1,1))=weekday(dateserial(2000,1,1)) thì chắc chắn weekday(dateserial(n,3,1))=weekday(dateserial(1999,3,1)). Bởi vậy chỉ cần gọi hàm weekday(dateserial(n,1,1)) 101 lần và so sánh là đủ.

 

[huuthang_bd]

Nếu là bài tập thì không nên cố định ở năm 1999 mà nên cho một năm bất kỳ cho tổng quát.

Sub LichCu()
Const NamCuoi = 3000
Dim Nam As Long, WDay As Long, i As Long, Arr(1 To 1000, 1 To 1)
Nam = 1999
WDay = Weekday(DateSerial(Nam, 1, 1))
If Day(DateSerial(Nam, 3, 0)) = 29 Then
    Do
        i = i + 1
        Arr(i, 1) = Nam
        If Weekday(DateSerial(Nam + 28, 1, 1)) = WDay Then
            Nam = Nam + 28
        ElseIf Weekday(DateSerial(Nam + 40, 1, 1)) = WDay Then
            Nam = Nam + 40
        End If
    Loop Until Nam > NamCuoi
Else
    Do
        i = i + 1
        Arr(i, 1) = Nam
        If Weekday(DateSerial(Nam + 6, 1, 1)) = WDay Then
            Nam = Nam + 6
        ElseIf Weekday(DateSerial(Nam + 11, 1, 1)) = WDay Then
            Nam = Nam + 11
        ElseIf Weekday(DateSerial(Nam + 12, 1, 1)) = WDay Then
            Nam = Nam + 12
        End If
    Loop Until Nam > NamCuoi
End If
Range("A1:A" & i) = Arr
End Sub

 

[SA_DQ]

Đó là mô đất trên con đường VBA, ngõ hầu ai đó vấp fải í mà!

& đây là 1 tham khảo:

Sub XaiLaiLichCu6ToCuaNam1999()
 Dim J%, fT As Integer, lT As Integer, W As Byte
 ReDim Arr(1 To 99, 1 To 1) As Integer
 
 fT = Weekday(#1/1/1999#)
 lT = Weekday(#3/13/1999#)
 For J = 2000 To 2099
    If Weekday(DateSerial(J, 1, 1)) = fT Then
        If Weekday(DateSerial(J, 3, 13)) = lT Then
            W = W + 1:      Arr(W, 1) = J
        End If
    End If
 Next J
 [AH1].Resize(W) = Arr()
End Sub

Hic, ngồi làm thủ công vì chả có quy tắc gì để tính, thì thấy các năm có thứ, ngày, tháng giống nhau như đúc, đó là các năm: 2010 (đã qua), 2021, 2038, 2049, 2066, 2077, ... (tính tới đây thôi, không biết có sống thêm được nữa không).

Cái ông gì đó ở nước Anh bị trái táo rơi vô mặt lúc ngủ mới fát hiện ra định luật 'Vạn vật hấp dẫn' mà!

 

[Hau151978]

Nếu là bài tập thì không nên cố định ở năm 1999 mà nên cho một năm bất kỳ cho tổng quát.

Kết quả như vậy không đúng đâu, năm 2112, 2140 ... là năm nhuận cũng có trong danh sách.

Option Explicit
Function NamNhuan(ByVal n As Long) As Boolean
    NamNhuan = (n Mod 4 = 0) And ((n Mod 100 <> 0) Or (n Mod 400 = 0))
End Function


Sub LichCu()
    Dim Nam As Long, NamCuoi As Long, WDay As Long, i As Long, j As Long, NamDauNhuan As Boolean, NamTruocNhuan As Boolean, Arr()
    Nam = [A1]
    NamCuoi = [B1]
    If NamCuoi<=Nam Then End
    ReDim Arr(1 To NamCuoi - Nam, 1 To 1)
    NamDauNhuan = NamNhuan(Nam)
    NamTruocNhuan = NamDauNhuan
    For i = Nam + 1 To NamCuoi
        WDay = WDay + IIf(NamTruocNhuan, 2, 1)
        NamTruocNhuan = NamNhuan(i)
        If NamDauNhuan = NamTruocNhuan And WDay Mod 7 = 0 Then
            j = j + 1
            Arr(j, 1) = i
        End If
    Next
    Range("A2:A" & j) = Arr
End Sub

 

[Vo Tinh]

Với 6 tờ lịch đặc biệt năm 1999 của Bác SA
Theo em Bác SA có thể sử dụng tờ lịch thứ nhất vào năm sau 2016
Sau đó Bác nên cất cẩn thận để đến năm 2179 Bác mang ra xài sẽ trùng được thứ, ngày, tháng, can, chi luôn

 

[Hau151978]

Với 6 tờ lịch đặc biệt năm 1999 của Bác SA
Theo em Bác SA có thể sử dụng tờ lịch thứ nhất vào năm sau 2016
Sau đó Bác nên cất cẩn thận để đến năm 2179 Bác mang ra xài sẽ trùng được thứ, ngày, tháng, can, chi luôn

Năm 2016 là năm nhuận còn 1999 không nhuận thì lịch trùng sao được bạn. Còn về âm lịch thì năm 2179 trùng can chi nhưng ngày âm lịch không trùng.

 

[huuthang_bd]

Kết quả như vậy không đúng đâu, năm 2112, 2140 ... là năm nhuận cũng có trong danh sách.

Đúng là như vậy, vậy cần kiểm tra xem có phải năm nhuận không nữa.

Sub LichCu()
Const NamCuoi = 3000
Dim Nam As Long, WDay As Long, i As Long, Arr(1 To 1000, 1 To 1)
Nam = 1999
WDay = Weekday(DateSerial(Nam, 1, 1))
If Day(DateSerial(Nam, 3, 0)) = 29 Then
    Do
        If Day(DateSerial(Nam, 3, 0)) = 29 Then
            i = i + 1
            Arr(i, 1) = Nam
        End If
        If Weekday(DateSerial(Nam + 28, 1, 1)) = WDay Then
            Nam = Nam + 28
        ElseIf Weekday(DateSerial(Nam + 40, 1, 1)) = WDay Then
            Nam = Nam + 40
        End If
    Loop Until Nam > NamCuoi
Else
    Do
        If Day(DateSerial(Nam, 3, 0)) = 28 Then
            i = i + 1
            Arr(i, 1) = Nam
        End If
        If Weekday(DateSerial(Nam + 6, 1, 1)) = WDay Then
            Nam = Nam + 6
        ElseIf Weekday(DateSerial(Nam + 11, 1, 1)) = WDay Then
            Nam = Nam + 11
        ElseIf Weekday(DateSerial(Nam + 12, 1, 1)) = WDay Then
            Nam = Nam + 12
        End If
    Loop Until Nam > NamCuoi
End If
Range("A1:A" & i) = Arr
End Sub

Các con số trong code ta tính được từ các trường hợp năm nhuận là năm tiêp theo thứ mấy từ năm đang xét.

Hoặc dễ hiểu hơn ta xét từ năm n+5 trở đi (n là năm đang xét) vì một năm không nhuận có 365 ngày, chia 7 dư 1. Trong 5 năm liên tiếp tối đa có 2 năm nhuận. Vậy để thứ của ngày 1/1 lặp lại cần tối thiểu 5 năm. Tương tự, cần tối thiểu 28 năm để có thể có một năm nhuận có thứ của ngày 1/1 lặp lại. Code như sau:

Sub LichCu1()
Const NamCuoi = 3000
Dim Nam As Long, WDay As Long, i As Long, Arr(1 To 1000, 1 To 1)
Nam = 1999
WDay = Weekday(DateSerial(Nam, 1, 1))
If Day(DateSerial(Nam, 3, 0)) = 29 Then
    Do Until Nam > NamCuoi
        If Day(DateSerial(Nam, 3, 0)) = 29 Then
            i = i + 1
            Arr(i, 1) = Nam
        End If
        Nam = Nam + 28
        Do Until Weekday(DateSerial(Nam, 1, 1)) = WDay
            Nam = Nam + 4
        Loop
    Loop
Else
    Do Until Nam > NamCuoi
        If Day(DateSerial(Nam, 3, 0)) = 28 Then
            i = i + 1
            Arr(i, 1) = Nam
        End If
        Nam = Nam + 5
        Do Until Weekday(DateSerial(Nam, 1, 1)) = WDay
            Nam = Nam + 1
        Loop
    Loop
End If
End Sub

 

[huuthang_bd]

Với 6 tờ lịch đặc biệt năm 1999 của Bác SA
Theo em Bác SA có thể sử dụng tờ lịch thứ nhất vào năm sau 2016
Sau đó Bác nên cất cẩn thận để đến năm 2179 Bác mang ra xài sẽ trùng được thứ, ngày, tháng, can, chi luôn

Nếu so cả lịch âm thì tôi e là không có năm nào trùng vì nói đến lịch âm bạn cần phải so cả ngày âm lịch. 01/01/1999 = 14/11/1998AL, 01/01/2179 = 24/11/2178AL

 

[ChanhTQ@]

Năm 2016 là năm nhuận còn 1999 không nhuận thì lịch trùng sao được bạn. Còn về năm 2179 trùng can chi nhưng ngày âm không . . . .

Thì xài 1 tờ thôi mà!, nhưng đến 29/02/2016 thì cất đi cho lẹ!

Kết quả của các macro bên trên là như sau
1999
2010: 11
2021: 11
2027: 06
2038: 11
2049: 11
2055: 06
2066: 11
2077: 11
2083: 06
2094: 11
. . . . . . Thì ra có qui luật rồi!

 

[tunguni]

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:

​

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

.
.
.

Mình tìm phần I trên diễn đàn không thấy, nhờ bạn gởi giúp. Thanks.

 

[SA_DQ]

Chắc nó đây nè bạn:

Mình tìm phần I trên diễn đàn không thấy, nhờ bạn gởi giúp. Thanks.

http://www.giaiphapexcel.com/forum/...VBA-đơn-giản-dành-cho-những-người-mới-bắt-đầu

 

[Vo Tinh]

Nếu so cả lịch âm thì tôi e là không có năm nào trùng vì nói đến lịch âm bạn cần phải so cả ngày âm lịch. 01/01/1999 = 14/11/1998AL, 01/01/2179 = 24/11/2178AL

Ý là trùng thêm can chi của năm thôi Anh à, 1999 = 2179 = KỶ MÃO
Chứ mà trùng can chi ngày giờ nữa thì chẳng biết đường nào mà tính

 

[ChanhTQ@]

Không cần bất cứ câu lệnh VBA nào, bạn nào đoán thử xem:

/(/ếu tôi có tờ lịch cũ năm 2004, thì năm nào tôi có thể đem nó ra xài lại?

(Dễ thường bài này HS cấp II cũng giải được đó nha!)

 

[doveandrose]

Không cần bất cứ câu lệnh VBA nào, bạn nào đoán thử xem:

/(/ếu tôi có tờ lịch cũ năm 2004, thì năm nào tôi có thể đem nó ra xài lại?

(Dễ thường bài này HS cấp II cũng giải được đó nha!)

nếu tờ lịch là năm 2004 (nhuận) thì khỏi sợ cái vụ năm thiên niên kỉ . cứ +4 mà tiến
1 năm nhuận thì gồm 52 tuần lẻ 2 ngày . vậy đến năm nhuận kế tiếp thì lẻ ra 2 + 3 = 5 ngày . 5 với 7 nguyên tố cùng nhau
=> phải đợi thêm 7 năm nhuận tiếp theo tức là 2004 + 7 * 4 = 2032 thì ngày tháng dương lịch sẽ giống 2004

 

[huuthang_bd]

nếu tờ lịch là năm 2004 (nhuận) thì khỏi sợ cái vụ năm thiên niên kỉ . cứ +4 mà tiến
1 năm nhuận thì gồm 52 tuần lẻ 2 ngày . vậy đến năm nhuận kế tiếp thì lẻ ra 2 + 3 = 5 ngày . 5 với 7 nguyên tố cùng nhau
=> phải đợi thêm 7 năm nhuận tiếp theo tức là 2004 + 7 * 4 = 2032 thì ngày tháng dương lịch sẽ giống 2004

Không phải cứ năm nhuận thì +28 là được vì có khi n+28 không phải là năm nhuận (ví dụ n = 2072)

 

[doveandrose]

Không phải cứ năm nhuận thì +28 là được vì có khi n+28 không phải là năm nhuận (ví dụ n = 2072)

nếu tờ lịch là năm 2004 (nhuận) thì khỏi sợ cái vụ năm thiên niên kỉ . cứ +4 mà tiến

cảm ơn bạn . nhưng mình bám sát đề bài mà làm . nếu gặp đề bài đây là năm 2080 đương nhiên + 28 là sai . và cũng mong bạn chỉ giáo để tôi và các bạn được học hỏi cách giải đúng

 

[VetMini]

Bài tập đơn giản cho người mới bắt đầu ????????????????

Một trong những cái khó của người mới bắt đầu là giữ mình trong phạm vi đề bài, không đi quá xa. Trong ngành IT, SCOPING (xác định phạm vi) là bước quan trọng nhất.

 

[huuthang_bd]

cảm ơn bạn . nhưng mình bám sát đề bài mà làm . nếu gặp đề bài đây là năm 2080 đương nhiên + 28 là sai . và cũng mong bạn chỉ giáo để tôi và các bạn được học hỏi cách giải đúng

Ặc. Nếu nói vậy thì năm 1999 thì ta cộng 11 là xong à

 

[doveandrose]

Ặc. Nếu nói vậy thì năm 1999 thì ta cộng 11 là xong à

Không cần bất cứ câu lệnh VBA nào, bạn nào đoán thử xem:

làm theo kiểu VBA khác , mà làm theo kiểu lấy giấy bút ra tính khác .
nhắc lại 1 lần nữa . tôi bám sát đề bài mà làm .

 

[aduy89]

Cần tìm sư phụ.
Mình đang mới bắt đầu học VBA. Cần tìm sư phụ chỉ bảo.. zalo : 01234632712.