Bài tập vòng lặp VBA cho người mới bắt đầu: (5 người xem)

[SA_DQ]

Hãy giúp tôi lập danh sách các ngày trong thế kỹ này đã, đang & sẽ có ngày 31 (của tháng) rơi vô chủ nhật.

 

[VetMini]

Bài tập "giải bài tập" cho người mới bắt đầu:
1. Đặt câu hỏi: mục đich của bài tập này là gì?
2. Tìm dữ liệu đầu vào và mẫu mã/điều kiện đầu ra
3. Xét lại xem mẫu mã/điều kiện đầu ra có đầy đủ để làm việc hay không? Nếu cần thì xem lại câu 1 ở trên.
4. Nếu mọi thứ ổn thỏa, bắt đầu động não làm việc.

 

[cantl]

chủ nhật

Bác nhỉ.
- Chủ nhật sẽ dựa vào 1 ngày gốc sẽ phải cho biết trước?
- Hay là dùng hàm WEEKDAY?
- Hay là +-*/, giả sử, giả định khác để tính ngày chủ nhật?
Em đang nghĩ đến for từ ảnh đến ảnh, rồi WEEKDAY. Nhưng mà không hay.

mục đich của bài tập

Bác ấy đang tính xem trong thế kỷ này sẽ uống rượu được bao nhiêu ngày chủ nhật nữa. Với điều kiện là ngày ấy phải đặc biệt chứ không đại trà. Tức là rượu có chọn lọc.

 

[heyhey1994]

Hãy giúp tôi lập danh sách các ngày trong thế kỹ này đã, đang & sẽ có ngày 31 (của tháng) rơi vô chủ nhật.

Sub SundaysWith31st()
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
   
    startDate = DateSerial(2000, 1, 1)
    endDate = DateSerial(2099, 12, 31)
    currentDate = startDate
    Do While currentDate <= endDate
        If Day(currentDate) = 31 And Weekday(currentDate) = vbSunday Then
            Debug.Print currentDate
        End If
        currentDate = DateSerial(Year(currentDate), Month(currentDate), Day(currentDate) + 1)
    Loop
End Sub

Dạ em xin trả bài ạ. Nhờ bác chữa giúp em.

 

[ptm0412]

Dạ em xin trả bài ạ. Nhờ bác chữa giúp em.

Vòng lặp thì đúng, nhưng nên có cách hạn chế số lần lặp, thay vì lặp đủ 36525 lần

 

[huhumalu]

Ý bác @SA_DQ là vòng lặp thì chắc dùng VBA.
Thì cứ thuần túy 01/01/2000 + 1 cho đến khi 31/12/2099;
Nếu Weekday(checkDate, vbSunday) = 1 && Day(checkDate) = 31
thì count = count +1
Chạy hết in màn hình thôi

 

[ongke0711]

Tháng có 31 ngày chỉ có: 1,3,5,7,8,10,12

 

[huhumalu]

Vòng lặp thì đúng, nhưng nên có cách hạn chế số lần lặp, thay vì lặp đủ 3675 lần

Chỉ đếm các tháng 1, 3, 5, 7, 8, 10, 12; và ghép giá trị luôn hả anh
này thành bài nâng cao;

Sub Count31Sundays()
    Dim ArrMonth()
    Dim checkDate As Date
    Dim List31Sunday() As Date
   
    ArrMonth = Array(1, 3, 5, 7, 8, 10, 12)
    count = 0
    For yr = 2000 To 2099
        For Each mth In ArrMonth
       
            checkDate = DateSerial(yr, mth, 31)
            If Weekday(checkDate, vbSunday) = 1 Then
                count = count + 1
                ReDim Preserve List31Sunday(1 To count)
                List31Sunday(count) = checkDate
            End If
            cnt = cnt + 1
        Next mth
    Next yr
    Range("A1").Resize(count, 1) = Application.Transpose(List31Sunday)
End Sub

** Cập nhật theo đề bài là "lập danh sách";

 

[cantl]

Kế thừa và DateSerial nó tự động nhảy lên mùng 1 tháng sau nên lại phải If 31.

Có cách nào không dùng Weekday các bác nhỉ?

Sub zzz()
For y = 2000 To 2099 Step 1
    For m = 1 To 12 Step 1
        currentDate = DateSerial(y, m, 31)
        If Day(currentDate) = 31 And Weekday(currentDate) = vbSunday Then
            Debug.Print currentDate
        End If
    Next
Next
End Sub

 

[VetMini]

Các bài trả lời đều bỏ qua điều kiện "mẫu mã đầu ra" tôi đã nêu trên. Tất cả đều tự đặt rằng tháng trình bày theo kiểu 7 ngày ngang 5 hàng dọc, với cột đầu tiên là ngày chủ nhật.

Bài toán này không dễ như chủ thớt tưởng. Nó có hai vòng lặp:

1. Vòng lặp do ngữ pháp (For...Next). Cái này dễ bẹt, đúng là bài tập căn bản, trình độ các bạn ra bài trên không cần lý tới nữa.

2. Vòng lặp do lô gic Toán số. Mục đích để tránh sự lặp lại vô ích. Tương tự như lấy tổng các số từ 1 đến n. Ta có thể làm vòng lăp đơn giản công lũy tiền n lần. Nhưng lô gic toán số cho biết chỉ cần làm con toán n*(n+1)/2.
Vì vậy, trước khi làm, phải đặt và giải quyết câu hỏi:
Trong 100 năm, có thể có chu lỳ lặp lại? Và nếu có thì chu kỳ ra sao, giải quyết cách nào theo ngữ pháp?

 

[SA_DQ]

	Ngày	Thứ	Delta
	12/29/2000	6
	3/29/2002	6	455
	8/29/2003	6	518
	10/29/2004	6	427
	7/29/2005	6	273
	12/29/2006	6	518
	8/29/2008	6	609
	5/29/2009	6	273
	1/29/2010	6	245
	10/29/2010	6	273
	7/29/2011	6	273
	3/29/2013	6	609
	8/29/2014	6	518
	5/29/2015	6	273
	1/29/2016	6	245
	7/29/2016	6	182
	12/29/2017	6	518
	3/29/2019	6	455
	5/29/2020	6	427
	1/29/2021	6	245
	10/29/2021	6	273
	7/29/2022	6	273
	12/29/2023	6	518
	3/29/2024	6	91
	8/29/2025	6	518
	5/29/2026	6	273
	1/29/2027	6	245
	10/29/2027	6	273
	12/29/2028	6	427
	3/29/2030	6	455
	8/29/2031	6	518
	10/29/2032	6	427
	7/29/2033	6	273
	12/29/2034	6	518
	8/29/2036	6	609
	5/29/2037	6	273
	1/29/2038	6	245
	10/29/2038	6	273
	7/29/2039	6	273
	3/29/2041	6	609
	8/29/2042	6	518
	5/29/2043	6	273
	1/29/2044	6	245
	7/29/2044	6	182
	12/29/2045	6	518
	3/29/2047	6	455

 

[ptm0412]

2. Vòng lặp do lô gic Toán số. Mục đích để tránh sự lặp lại vô ích.

Logic thông thường: 36525 ngày, lặp 36525 lần.
Thêm "logic toán số":
Logic 1: Một tuần chỉ có 1 chủ nhật. Nếu lặp theo tuần thì chỉ 5200 tuần & 5200 vòng lặp
Logic 2: Một tháng chỉ có 1 ngày cuối tháng. Nếu lặp theo tháng thì chỉ lặp 1200 vòng lặp
Logic 3: 1 năm chỉ có 7 tháng có ngày 31. Nếu tìm cách lặp theo logic này thì chỉ lặp 700 vòng lặp.

Vậy nên chọn theo logic 3.

 

[SA_DQ]

M. Bing hướng dẫn mình xài 3 vòng lặp . . . (!)
& hắn ta lấy ngày 0 của tháng kế tiếp (2, 4, . . . ,1)

Xin chúc các bạn vui & khỏe!

 

[HUONGHCKT]

Logic thông thường: 36525 ngày, lặp 36525 lần.
Thêm "logic toán số":
Logic 1: Một tuần chỉ có 1 chủ nhật. Nếu lặp theo tuần thì chỉ 5200 tuần & 5200 vòng lặp
Logic 2: Một tháng chỉ có 1 ngày cuối tháng. Nếu lặp theo tháng thì chỉ lặp 1200 vòng lặp
Logic 3: 1 năm chỉ có 7 tháng có ngày 31. Nếu tìm cách lặp theo logic này thì chỉ lặp 700 vòng lặp.

Vậy nên chọn theo logic 3.

Mượn code của bạn cantl và theo gợi ý của anh @ptm0412 tôi code lại thế này.

Option Explicit

Sub zzz()
Dim Thang, t&, y&, m&, CurrentDate As Date
Thang = Array(1, 3, 5, 7, 8, 10, 12)
For y = 2000 To 2099
    For m = LBound(Thang) To UBound(Thang)
        CurrentDate = DateSerial(y, Thang(m), 31)
        If Weekday(CurrentDate) = vbSunday Then
            t = t + 1
            Sheet2.Range("A" & t) = CurrentDate
        End If
    Next
Next
End Sub

kết quả chạy code được 98 đáp án.

 

[ptm0412]

Thế kỷ 21 bắt đầu từ 01/01/2001 đến hết ngày 31/12/2100

 

[cantl]

Em nhặt nhạnh và chắp vá lại các ý kiến luôn.
Array nhanh thật!!!

Option Explicit

Sub zzz()
    Dim Thang, t&, y&, m, CurrentDate As Date
    Dim List31Sunday()
    Dim Count&, i&
    Dim tmr#
    tmr = Timer
    Count = 0
    Thang = Array(1, 3, 5, 7, 8, 10, 12)
    For y = 2001 To 2100
        For Each m In Thang
            i = i + 1
            CurrentDate = DateSerial(y, m, 31)
            If CurrentDate Mod 7 = 1 Then
                Count = Count + 1
                ReDim Preserve List31Sunday(1 To Count)
                List31Sunday(Count) = CurrentDate
            End If
        Next
    Next
    Range("A1").Resize(Count, 1) = Application.Transpose(List31Sunday)
    MsgBox "lap " & i & " vong lap trong " & ((Timer - tmr) * 1000) & " miligiay"
End Sub

 

[LmoovoenX]

Nếu xài hàm của office 365 em sẽ duyệt như sau

=LET(a,SEQUENCE(100,,2001),c,MAP(a,LAMBDA(x,TEXTJOIN(",",1,CHOOSE(WEEKDAY(DATE(x,3,31),1),3,8,{5,13},10,7,12,"")+12*(x-2000)))),TEXT(DATE(2000,TEXTSPLIT(TEXTJOIN(",",1,IF(WEEKDAY(MIN(a)&"/1/31",1)=1,1,""),IFERROR(c,"")),,","),31),"ddd dd mm yyyy"))

Chỗ này em chưa biết cách xử lý mảng 2 chiều nên dùng textsplit, textjoin để nối và tách chuỗi.

 

[SA_DQ]

Còn đây là ChartGPT 4 dạy cho mình:

Sub ListSundays()
    Dim i As Integer, J As Integer, K As Integer, Year As Integer
    Dim Month As Integer, LastDay As Integer, DayOfWeek As Integer, Count As Integer
    Dim sundays() As String
    ReDim sundays(0 To 0)
   
    Count = 0
    For i = 20 To 99
        Year = i * 100
        For J = 1 To 12
            Month = J
            LastDay = Day(DateSerial(Year, Month + 1, 0))
            For K = 1 To LastDay
                DayOfWeek = Weekday(DateSerial(Year, Month, K))
                If K = 31 And DayOfWeek = 1 Then
                    ReDim Preserve sundays(0 To Count)
                    sundays(Count) = Format(DateSerial(Year, Month, K), "dd/mm/yyyy")
                    Count = Count + 1
                End If
            Next K
        Next J
    Next i
    If Count = 0 Then
        MsgBox "Không có ngày 31 nào trong các tháng của thế kỷ này roi vào chủ nhật."
    Else
        MsgBox "Các ngày 31 trong các tháng của thế kỷ này roi vào chủ nhật là: " & Join(sundays, ", ")
    End If
End Sub

 

[cantl]

For i = 20 To 99
Year = i * 100

Nó hiểu thế kỷ từ 2000, vậy là nó hiểu sai giống em.

 

[SA_DQ]

(/ậy bạn nghỉ Y2K là như thế nào?