Bài tập về vòng lặp

[ndu96081631]

Những ai đã từng xem qua bài viết này: Giới thiệu Cơ bản về vòng lặp For . . . next của sư phụ ptm0412 giờ hãy cùng làm 1 vài bài tập từ đơn giản đến nâng cao nhé
Xin mở màn bằng 1 bài tập sau:

Bài tập 01:

Hãy tính xem từ năm 1900 đến nay có bao nhiêu ngày thuộc dạng THỨ SÁU NGÀY 13
------------------------
Các bạn ai có bài tập gì hay xin post lên đây nhé! Cảm ơn

 

[ndu96081631]

Khá lắm!
Nghĩ ra được For j = 1 to 4 là trình độ suy luận của bạn của đã nâng cao nhiều lắm rồi đấy
Giờ chỉ còn công đoạn nữa là đưa mọi thứ tìm được vào mảng (thay vì điền kết quả trực tiếp vào cell) ---> Như vậy tốc độ sẽ nhanh hơn

 

[viehoai]

Bài 6

Trong tập hợp các số có 6 chữ số (từ 100.000 đến 999.999):

a. Đếm và liệt kê các số có 3 chữ số giống nhau lên bảng tính, (2, 4, 5, 6 số giống nhau là không tính). 3 chữ số giống nhau này nằm ở vị trí bất kỳ, thí dụ 333456, 345633, 334563, 433356, 343536, ...333645, ...
b. Cố gắng giảm thiểu số vòng lặp, nên có 1 biến đếm số lần lặp để so sánh với số kết quả.
c. Nếu có thể, sử dụng mảng để tăng tốc độ.

Sư phụ ơi đúng là một bài tập khó thật, hay là sư phụ cho các đệ đau đầu khỏi chơi Lễ luôn? he he vui với sư phụ vậy thôi
Em sẽ cố gắng, về mãng em chưa biết và chưa được nghiên cứu, như vầy sẽ tốt cho em. Cảm ơn các sư phụ

 

[ptm0412]

Góp ý về thuật toán:
Code của minhCong sau vài lần cải tiến, cũng chỉ là 1 thuật toán. Duyệt qua tất cả các số (400.001 số), dò 4 lần (code sau cùng), nhân lên là 1.600.004 lần VBA đánh vật với các con số. Nhờ câu exit For, số lần lặp giảm còn 1.469.324.
Nếu cải tiến tốt hơn nữa, là dùng Aray, cũng vẫn là thuật toán cũ, coi như, chỉ đạt câu 6a.

Hãy làm sao, suy luận theo hướng khác, giảm được số lần lặp?

 

[ndu96081631]

Góp ý về thuật toán:
Code của minhCong sau vài lần cải tiến, cũng chỉ là 1 thuật toán. Duyệt qua tất cả các số (400.001 số), dò 4 lần (code sau cùng), nhân lên là 1.600.004 lần VBA đánh vật với các con số. Nhờ câu exit For, số lần lặp giảm còn 1.469.324.
Nếu cải tiến tốt hơn nữa, là dùng Aray, cũng vẫn là thuật toán cũ, coi như, chỉ đạt câu 6a.

Hãy làm sao, suy luận theo hướng khác, giảm được số lần lặp?

Em nghĩ làm được như MinhCong là quá đạt yêu cầu rồi, ít nhất là yêu câu của topic này (dành cho người mới học) ---> Cao cấp hơn nữa về thuật toán nên bàn ở 1 topic khác thì hơn
(ngợp quá người ta chạy hết)

 

[ptm0412]

Để có thể chạy từ 100.000 đến 999.999 trong 2003, ta sẽ chia thành từng cụm 10.000 số hoặc 20.000 số như sau:

Dùng 1 biến dòng, tăng dần, nếu = 10.000 thì quay về 1
Dùng 1 biến cột, nếu dòng = 1 thì tăng cột lên 1.

Dim iRow As Long, iCol As Long
iRow = IIf(iRow = 10000, 1, iRow +1)
iCol = IIf(iRow = 1, iCol +1, iCol)
Cells(iRow, iCol) = ...

 

[MinhCong]

Góp ý về thuật toán:
Code của minhCong sau vài lần cải tiến, cũng chỉ là 1 thuật toán. Duyệt qua tất cả các số (400.001 số), dò 4 lần (code sau cùng), nhân lên là 1.600.004 lần VBA đánh vật với các con số. Nhờ câu exit For, số lần lặp giảm còn 1.469.324.
Nếu cải tiến tốt hơn nữa, là dùng Aray, cũng vẫn là thuật toán cũ, coi như, chỉ đạt câu 6a.

Hãy làm sao, suy luận theo hướng khác, giảm được số lần lặp?

Theo Em nghĩ nếu có thể giảm số vòng lặp xuống bằng cách cho i chạy giảm xuống thay vì từ i=100000 to 500000 giảm xuống còn i=100000 to 200000 và kết quả đếm số sẽ nhân thêm 4 nữa là được. Tuy nhiên để ghi kết quả ra thì phải thêm 1thuật toán nữa, không biết có được không nhỉ?

 

[ptm0412]

gợi ý vầy:
Thay vì duyệt qua tất cả các số, ta tìm quy luật số rồi liệt kê ra. Thí dụ:
1.- Cho 3 số giống nhau, chẳng hạn 000, 3 số còn lại mỗi số từ 1 đến 9, vậy thay từ từ vào 3 số còn lại, thay đến đâu, ghi lại đến đó. (Ghi xuống sheet hoặc ghi vào mảng)
2.- Tìm tất cả vị trí có thể của 3 số 000. Lặp lại bước 1.
3.- Thay 3 số 000 bằng 111, 3 số còn lại là 0 và từ 2 đến 9. Lặp lại bước 1 và 2.

Theo thuật toán này thì có bao nhiêu số thoả điều kiện, sẽ chạy đúng bấy nhiêu vòng lặp. Code chắc chắn là dài hơn, nhưng chạy nhanh hơn.

Suy luận là thế (thuật toán hoặc giải thuật), còn thủ thuật, là dùng mấy vòng For, bao nhiêu điều kiện, bao nhiêu trường hợp, ... thì nghĩ thêm.

 

[boyxin]

Bài 6

Trong tập hợp các số có 6 chữ số (từ 100.000 đến 999.999):

a. Đếm và liệt kê các số có 3 chữ số giống nhau lên bảng tính, (2, 4, 5, 6 chữ số giống nhau là không tính). 3 chữ số giống nhau này nằm ở vị trí bất kỳ, thí dụ 333456, 345633, 334563, 433356, 343536, ...333645, ...

b. Cố gắng giảm thiểu số vòng lặp, nên có 1 biến đếm số lần lặp để so sánh với số kết quả.

c. Nếu có thể, sử dụng mảng để tăng tốc độ.

Em xin hỏi chút:

1) Số có tới 2 cặp 3 chữ số giống nhau
VD: 100011; 111222; ... có được tính không?

2) Số có 3 chữ số giống nhau nhưng lại có 2 chữ số khác cũng giống nhau
VD: 100012, 100022, ... có được tính không?

 

[ndu96081631]

Em xin hỏi chút:

1) Số có tới 2 cặp 3 chữ số giống nhau
VD: 100011; 111222; ... có được tính không?

2) Số có 3 chữ số giống nhau nhưng lại có 2 chữ số khác cũng giống nhau
VD: 100012, 100022, ... có được tính không?

Tính luôn bạn à! Miễn sao tìm thấy 3 ông giống nhau (nằm ở bất cứ vị trí nào) là được rồi
--------------------------------------

gợi ý vầy:
Thay vì duyệt qua tất cả các số, ta tìm quy luật số rồi liệt kê ra. Thí dụ:
1.- Cho 3 số giống nhau, chẳng hạn 000, 3 số còn lại mỗi số từ 1 đến 9, vậy thay từ từ vào 3 số còn lại, thay đến đâu, ghi lại đến đó. (Ghi xuống sheet hoặc ghi vào mảng)
2.- Tìm tất cả vị trí có thể của 3 số 000. Lặp lại bước 1.
3.- Thay 3 số 000 bằng 111, 3 số còn lại là 0 và từ 2 đến 9. Lặp lại bước 1 và 2.
.

Dùng cách này chẳng dễ ăn đâu nha!
Ví dụ:
- Cho trước số 000
- Cho thêm số 442 rồi hoán vị 3 chữ số này với 3 chữ số của số 000
- Trong các kết quả tìm được, chắc chắc có số 442000
- Giờ đổi số 442 thành 244 rồi hoán vị với 000 ---> Trong các kết quả tìm được chắc chắn cũng sẽ có số 442000
===> Nội chuyện loại ra các giá trị trùng cũng đủ mệt rồi ---> Chẳng lẽ phải dùng Dictionary Object?

 

[ptm0412]

Ví dụ:
- Cho trước số 000
- Cho thêm số 442 rồi hoán vị 3 chữ số này với 3 chữ số của số 000
- Trong các kết quả tìm được, chắc chắc có số 442000
- Giờ đổi số 442 thành 244 rồi hoán vị với 000 ---> Trong các kết quả tìm được chắc chắn cũng sẽ có số 442000
===> Nội chuyện loại ra các giá trị trùng cũng đủ mệt rồi ---> Chẳng lẽ phải dùng Dictionary Object?

Nếu thay từ từ từng chữ số một thì không bị trùng kiểu 442000 nhiều lần

Thí dụ với 3 số 111, vị trí 3 số nằm đầu, dạng 111xyz:

Sub abc()
a = 1: b = 1: c = 1
Arr1 = Array(0, 2, 3, 4, 5, 6, 7, 8, 9)
For Each A1 In Arr1
    For Each A2 In Arr1
       For Each A3 In Arr1
          l = l + 1
          Cells(l, 1) = a & a & a & A1 & A2 & A3
Next A3, A2, A1
End Sub

Chỉ còn trùng dạng 111222, 111333, ...
Và chỉ cần thêm điều kiện:

If A1 = A2 and A2 = A3 Then Exit For

 

[boyxin]

Em làm theo chỉ dẫn của Anh theo Em nghĩ là chỉ cần 4 vòng lặp cho j thôi.

Sub Lietke()
Dim i As Long, j As Integer, demso As Long
Cells.Clear
For i = 100000 To 500000
    For j = 1 To 4
        With Cells(demso + 1, 1)
            If Len(Replace(i, Mid$(i, j, 1), "")) = 3 Then
                .Value = i
                demso = demso + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

Sửa chút xíu như sau, thời gian giảm xuống đáng kể (thông số test trên máy của boyxin trong file đính kèm)

Sub Lietke3()
Dim Tmp, t, i As Long, j As Byte, ic As Byte, ir As Long
    t = Timer
    [a1].CurrentRegion.ClearContents
    Tmp = [a1].Resize(15000, 4).Value
For i = 100000 To 499999
    ic = Int(i / 100000)
    For j = 1 To 4
        If Len(Replace(i, Mid$(i, j, 1), "")) = 3 Then
            ir = IIf(ir >= 14490, 1, ir + 1)
            Tmp(ir, ic) = i: Exit For
End If: Next: Next
[a1].Resize(ir, 4) = Tmp: [n1] = Timer - t
End Sub

 

[ndu96081631]

Bài tập mới

Nhân tiện có bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?39955-Giúp-mình-cách-đánh-dấu-giữa-các-chữ-số-với
Vậy chúng ta cùng làm 1 bài tập mới như sau:
Tạo 1 Function để tách 1 chuổi ra thành nhiều nhóm. Số lượng ký tự trong mỗi nhóm do ta định nghĩa và mỗi nhóm cách nhau bởi 1 dấu phân cách nào đó cũng do ta định nghĩa
Ví dụ:

Function Tach(Chuoi as String, Nhom as Long, PC  as String) as String
...
End Function

Với chuổi aaaaa thì hàm Tach("aaaaa", 3, "-") sẽ cho kết quả = aaa-aa
Với chuổi aaaaa thì hàm Tach("aaaaa", 2, "-") sẽ cho kết quả = aa-aa-a
---------------
Bài này không khó nhưng hơi rối 1 chút

 

[MinhCong]

Nhân tiện có bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?39955-Giúp-mình-cách-đánh-dấu-giữa-các-chữ-số-với
Vậy chúng ta cùng làm 1 bài tập mới như sau:
Tạo 1 Function để tách 1 chuổi ra thành nhiều nhóm. Số lượng ký tự trong mỗi nhóm do ta định nghĩa và mỗi nhóm cách nhau bởi 1 dấu phân cách nào đó cũng do ta định nghĩa
Ví dụ:

Function Tach(Chuoi as String, Nhom as Long, PC  as String) as String
...
End Function

Với chuổi aaaaa thì hàm Tach("aaaaa", 3, "-") sẽ cho kết quả = aaa-aa
Với chuổi aaaaa thì hàm Tach("aaaaa", 2, "-") sẽ cho kết quả = aa-aa-a
---------------
Bài này không khó nhưng hơi rối 1 chút

Hè hè, Bài đó Anh đã làm rồi còn gì, chỉ cần thay lại Nhóm và PC là được thôi mà.

Function Tach(Chuoi As String, Nhom As Long, PC As String) As String
  Dim i As Long, j As Long
    On Error Resume Next
      Chuoi = Replace(Chuoi, " ", "")
       j = (Len(Chuoi) - 1) Mod Nhom
          For i = Len(Chuoi) - j To 1 Step -Nhom
              Tach = Mid(Chuoi, i, Nhom) & " " & Tach
          Next
  Tach = Replace(Trim(Tach), " ", PC)
End Function

 

[concogia]

Nhân tiện có bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?39955-Giúp-mình-cách-đánh-dấu-giữa-các-chữ-số-với
Vậy chúng ta cùng làm 1 bài tập mới như sau:
Tạo 1 Function để tách 1 chuổi ra thành nhiều nhóm. Số lượng ký tự trong mỗi nhóm do ta định nghĩa và mỗi nhóm cách nhau bởi 1 dấu phân cách nào đó cũng do ta định nghĩa
Ví dụ:

Function Tach(Chuoi as String, Nhom as Long, PC as String) as String
...
End Function

Với chuổi aaaaa thì hàm Tach("aaaaa", 3, "-") sẽ cho kết quả = aaa-aa
Với chuổi aaaaa thì hàm Tach("aaaaa", 2, "-") sẽ cho kết quả = aa-aa-a
---------------
Bài này không khó nhưng hơi rối 1 chút

Bài này mình thấy nó y chang mấy bài vừa làm mà Thầy, nó chỉ mang tính tổng quát thôi

Public Function cungzi(Vung As String, Dk As Integer, Dau As String) As String
    Dim i As Integer, Tam As String, j As String
            For i = 1 To Len(Vung)
                    j = Mid(Vung, i, 1)
                If i Mod Dk = 0 Then
                    Tam = Tam & j & Dau
                Else
                    Tam = Tam & j
                End If
            Next
    If Len(Vung) Mod Dk = 0 Then
        cungzi = Left(Tam, Len(Tam) - 1)
    Else
        cungzi = Tam
    End If
End Function

Nếu số ký tự tách (Vung) ít hơn điều kiện tách (Dk) thì sao?
Híc, đề này dễ.... eeeccctttttt

 

[MinhCong]

Bài này mình thấy nó y chang mấy bài vừa làm mà Thầy, nó chỉ mang tính tổng quát thôi

Public Function cungzi(Vung As String, Dk As Integer, Dau As String) As String
    Dim i As Integer, Tam As String, j As String
            For i = 1 To Len(Vung)
                    j = Mid(Vung, i, 1)
                If i Mod Dk = 0 Then
                    Tam = Tam & j & Dau
                Else
                    Tam = Tam & j
                End If
            Next
    If Len(Vung) Mod Dk = 0 Then
        cungzi = Left(Tam, Len(Tam) - 1)
    Else
        cungzi = Tam
    End If
End Function

Nếu số ký tự tách (Vung) ít hơn điều kiện tách (Dk) thì sao?
Híc, đề này dễ.... eeeccctttttt

Theo Em nghĩ thêm 1 điều kiện IF nữa để tránh trường hợp Nhóm<=0 hoặc Nhóm>Len(Chuoi) là được.

Function Tach(Chuoi As String, Nhom As Long, PC As String) As String
  Dim i As Long, j As Long
    On Error Resume Next
      Chuoi = Replace(Chuoi, " ", "")
    If Nhom <= 0 Or Nhom > Len(Chuoi) Then
       Tach = Chuoi
    Else
       j = (Len(Chuoi) - 1) Mod Nhom
          For i = Len(Chuoi) - j To 1 Step -Nhom
             Tach = Mid(Chuoi, i, Nhom) & " " & Tach
          Next
     Tach = Replace(Trim(Tach), " ", PC)
     End If
End Function

Không biết có bị tèo hay không nhỉ?

 

[ndu96081631]

Bài này mình thấy nó y chang mấy bài vừa làm mà Thầy, nó chỉ mang tính tổng quát thôi

Vấn đề là code càng ngắn càng tốt ---> Em thấy code của anh IF nhiều quá đi mất
------------------------

Theo Em nghĩ thêm 1 điều kiện IF nữa để tránh trường hợp Nhóm<=0 hoặc Nhóm>Len(Chuoi) là được.

Nếu Nhom < 0 tức là ta cố tình "phá" rồi còn gì ---> MS cũng không thể nào lường nổi mấy vụ này
Đàng nào thì cũng đã có On Error Resume Next rồi còn gì
Nếu Nhom > Len(Chuoi) ---> Vụ này chẳng có vấn đề gì
------------------------
Bài này tôi nghĩ quét thuận sẽ dễ hơn đấy
Nếu code này thì sao?

  Chuoi = Replace(Chuoi, " ", "")
  j = Int(Len(Chuoi) / Nhom) + ((Len(Chuoi) Mod Nhom) = 0)
  For i = 0 To j
  ......

Thử làm bài này mà không có IF nào hết xem!

 

[concogia]

Vấn đề là code càng ngắn càng tốt ---> Em thấy code của anh IF nhiều quá đi mất
------------------------

Nếu Nhom < 0 tức là ta cố tình "phá" rồi còn gì ---> MS cũng không thể nào lường nổi mấy vụ này
Đàng nào thì cũng đã có On Error Resume Next rồi còn gì
Nếu Nhom > Len(Chuoi) ---> Vụ này chẳng có vấn đề gì
------------------------
Bài này tôi nghĩ quét thuận sẽ dễ hơn đấy
Nếu code này thì sao?

Chuoi = Replace(Chuoi, " ", "")
j = Int(Len(Chuoi) / Nhom) + ((Len(Chuoi) Mod Nhom) = 0)
For i = 0 To j
......

Thử làm bài này mà không có IF nào hết xem!

Cái này không có IF

Public Function tachhoai(Vung As Range, Dk As Integer, Dau As String) As String
    Dim Thay As String, Tam As String, I As Integer
        For I = 1 To Len(Vung) Step Dk
            Thay = Dau & Mid(Vung, I, Dk)
            Tam = Tam & Thay
        Next
    tachhoai = Right(Tam, Len(Tam) - 1)
End Function

 

[rollover79]

Vấn đề là code càng ngắn càng tốt ---> Em thấy code của anh IF nhiều quá đi mất
------------------------

Nếu Nhom < 0 tức là ta cố tình "phá" rồi còn gì ---> MS cũng không thể nào lường nổi mấy vụ này
Đàng nào thì cũng đã có On Error Resume Next rồi còn gì
Nếu Nhom > Len(Chuoi) ---> Vụ này chẳng có vấn đề gì
------------------------
Bài này tôi nghĩ quét thuận sẽ dễ hơn đấy
Nếu code này thì sao?

  Chuoi = Replace(Chuoi, " ", "")
  j = Int(Len(Chuoi) / Nhom) + ((Len(Chuoi) Mod Nhom) = 0)
  For i = 0 To j
  ......

Thử làm bài này mà không có IF nào hết xem!

Về cơ bản bài này mọi người đã giải quyết xong rồi, xin góp vui 1 code như sau, không có IF và không có vòng lặp luôn

Function test(str As String, iNumber As Integer, sSplit As String) As String
    On Error Resume Next
    str = str & String(WorksheetFunction.Ceiling(Len(str), iNumber) - Len(str), vbBack)
    test = Replace(Join(Evaluate("TRANSPOSE(MID(""" & str & """,(ROW(1:" & Len(str) \ iNumber & ")-1)*" & iNumber & "+1," & iNumber & "))"), sSplit), vbBack, "")
End Function

 

[ptm0412]

Tạm thời chưa có bài tập mới, các bạn hãy nghiên cứu topic Liệt kê các số đẹp lên bảng tính.
Tất cả các bài giải đều dùng vòng lặp For, tuy nhiên, mỗi người đưa lên 1 thuật toán khác nhau, các thủ thuật cũng khác nhau, cuối cùng là biện pháp cải thiện tốc độ. Co thể nói đó là những bài tập hay về suy luận logic và thủ thuật. Đặc biệt là biện pháp ứng dụng mảng.

 

[huuthang_bd]

Trong thời gian chờ đợi một bài tập hay các bạn thử làm bài này xem:

Tạo một Sub() để tạo mã theo nguyên tắc sau: Người dùng sẽ nhập vào mã bắt đầu gồm 5 chữ cái (XXXXX) và số lượng mã cần tạo (n), code sẽ tạo ra dãy n mã tiếp theo mã người dùng đã nhập. Các mã mới tạo nhập vào cột A bắt đầu từ A1.
Ví dụ: Nhập vào mã HUBIY và n = 6. Code sẽ tạo ra các mã HUBIZ, HUBJA, HUBJB, HUBJC, HUBJD, HUBJE