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
Không biết như thế này có đúng không, Anh xem giúp nhé!
Mã:
Sub tinhngay()
Dim i As Date: Dim tong As Long
tong = 0
For i = DateSerial(1900, 1, 1) To DateSerial(2010, 8, 17)
If Weekday(i) = 6 And Day(i) = 13 Then tong = tong + 1
Next
MsgBox "So ngay la: " & tong
End Sub
Cám ơn ndu đã nhắc tới và tiếp tục topic cũ. Quả thực lúc viết topic đó, mình nhớ gì viết nấy, và cũng muốn có nhiều bài tập hay hay từ thấp đến cao, nhưng nhất thời không nghĩ ra.
Nhân đây, mình rất mong mỏi những thành viên đang tập tành học VBA , nên tham gia topic này. Kể cả một vài thành viên đang viết code ầm ầm, nhưng theo nhận xét riêng thì đang rất mất căn bản trong tư duy logic.
Tư duy logic là cái cần thiết nhất, căn bản nhất mà người lập trình cần phải có. Các câu lệnh, cú pháp, hàm có sẵn, từ khoá, ... có thể mở Help lên xem, hoặc vào GPE hỏi, chứ tư duy logic thì không ai giúp được. Chỉ có thể rèn luyện bằng những bài tập nhỏ, những ứng dụng nhỏ, vận động trí óc tìm ra thuật toán để giải, ..
Rèn luyện tư duy, thì đây là 1 topic rất hay để các bạn tham gia và rèn luyện.
Đừng nghĩ rằng khi Excel đã có hàm giai thừa mà bắt các bạn tính giai thừa 1 số n bằng VBA là vô bổ, đó là rèn luyện suy luận đấy.
Hãy bắt đầu từ cái đơn giản nhất.
Gởi ndu:
Hãy từ từ nhé, hãy để vài người tham gia giải quyết cho rốt ráo 1 bài tập, rồi hãy đưa bài tập kế.
Sub Test()
Dim SoNgay As Long
For i = 1 To (Year(Date) - 1900) * 12 + Month(Date) + (Day(Date) < 13)
If Weekday(DateSerial(1900, i, 13)) = 6 Then SoNgay = SoNgay + 1
Next
MsgBox SoNgay
End Sub
Trường hợp này dùng Do Until... Loop có lẽ là hay hơn
PHP:
Sub Test()
Dim SoNgay As Long, i As Long
Do Until DateSerial(1900, i, 13) > Date
i = i + 1
If Weekday(DateSerial(1900, i, 13)) = 6 Then SoNgay = SoNgay + 1
Loop
MsgBox SoNgay
End Sub
Đúng là cần gì phải lặp theo ngày, vì ngày có sẵn là 13 rồi. Em sửa code lại như sau:
Mã:
Sub tinhngay1()
Dim i, j As Date: Dim tong As Long
tong = 0
For j = 1900 To 2010
For i = 1 To 12
If Weekday(DateSerial(j, i, 13)) = 6 Then tong = tong + 1
Next i
Next j
MsgBox "So ngay la: " & tong
End Sub
Tuy nhiên cái hàm Weekday(DateSerial(j, i, 13)) Em không biết thay hàm nào khác cả?
- Vì thay thuật toán, nên i, j không phải là Date nữa, mà là Long
- Sự thực là i chưa khai báo kiểu, chỉ mới khai báo kiểu cho j và tong.
- Tính dư cho tháng 9 đến tháng 12 của năm 2010.
- Dùng Weekday đâu có vấn đề gì đâu?
Anh giải thích giúp Em sao biến i chưa được khai báo với, vì Em nghĩ đặt i và j cách nhau dấu "," thì nó hiểu hết chứ nhỉ?
Mã:
Sub tinhngay()
Dim i As Integer
Dim j As Long: Dim tong As Long
tong = 0
For j = 1900 To 2010
For i = 1 To 12
If Weekday(DateSerial(j, i, 13)) = 6 And DateSerial(j, i, 13) <= Date Then tong = tong + 1
Next i
Next j
MsgBox "So ngay la: " & tong
End Sub
Anh Bill quy định thế mà, biết làm sao được.
Phải khai báo đầy đủ:
Dim i As Long, j As Long, tong As Long.
Thử như vầy sẽ biết: Dùng 1 dòng lệnh kiểm tra:
i = "GPE"
Nếu khai báo đủ như dòng trên, thì dòng lệnh này sẽ báo lỗi Type Mismatch. Điều này có lợi khi muốn loại giá trị không thích hợp.
Nếu khai báo thiếu, anh Bill thấy text cũng mặc kệ.
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
Theo tôi với vòng lặp thì bài này có thể finish được rồi, 1 vòng lặp hay 2 vòng lặp thì số lượng phép toán là như nhau, các bạn có thể tìm hiểu thêm phương pháp không dùng vòng lặp(đệ quy) xem sao.
Liên quan đến vòng lặp thì thường là các bài liên quan đến xử lý mảng, sắp xếp, ma trận, xử lý chuỗi ... Tôi xin góp vui 1 bài như sau Bài tập 02: Nhập vào 1 số N nguyên dương, in ra sheet hiện hành trên 1 vùng N cột, N dòng bắt đầu từ ô A1 với vùng đó chứa các số tự nhiên từ 1 đến N*N theo vòng xoáy ốc. Ví dụ N=5 ta sẽ phải in ra sheet hiện hành là
Theo tôi với vòng lặp thì bài này có thể finish được rồi, 1 vòng lặp hay 2 vòng lặp thì số lượng phép toán là như nhau, các bạn có thể tìm hiểu thêm phương pháp không dùng vòng lặp(đệ quy) xem sao.
Liên quan đến vòng lặp thì thường là các bài liên quan đến xử lý mảng, sắp xếp, ma trận, xử lý chuỗi ... Tôi xin góp vui 1 bài như sau Bài tập 02: Nhập vào 1 số N nguyên dương, in ra sheet hiện hành trên 1 vùng N cột, N dòng bắt đầu từ ô A1 với vùng đó chứa các số tự nhiên từ 1 đến N*N theo vòng xoáy ốc. Ví dụ N=5 ta sẽ phải in ra sheet hiện hành là
Bạn ơi! Bài tập này rất hay nhưng tôi e rằng quá khó so với trình độ của những bạn mới vào nghề (cả tôi cũng chưa nghĩ ra hướng giải quyết nữa đây)
Vậy... cứ từ từ nha bạn!
Nếu sư phụ ptm0412 hoặc các bạn khác nghĩ ra được bài nào đó ở tầm trung trở xuống, xin vui lòng gữi lên đây nhé
(Bài của rollover79, ai nghĩ ra thì cứ đưa code lên, không nghĩ được cũng không sao ---> Chúng ta cùng tiếp tục để nâng cao tay nghề thôi)
Bài tập 03: Chuẩn hoá 1 chuỗi đầu vào theo nguyên tắc: Không tồn tại 2 ký tự liền kề giống nhau, các ký tự không liền kề vẫn có thể giống nhau. Ví dụ với chuỗi đầu vào là "AABBBBCCCCDDAAAAAA" thì chuỗi sau khi chuẩn hoá là "ABCDA"
Xin đóng góp một câu trả lời với 2 vòng lặp theo cách tiếp cận vừa xử lý nén vừa duyệt qua chuỗi
PHP:
Private Function Normalize(Optional InputString As String = "") As String
' Normalize all
'AABBBBCCCCDDAAAAAA
Dim xStr As String, Tmp As String, i As Long
' Get first occurent
If InputString = "" Then
xStr = "AABBBBCCCCDDAAAAAA"
Else
xStr = InputString
End If
While i < Len(xStr)
Tmp = Mid(xStr, i + 1, 1)
While InStr(xStr, Tmp & Tmp) > 0
xStr = Replace(xStr, Tmp & Tmp, Tmp)
Wend
i = i + 1
Debug.Print xStr
Wend
Normalize = xStr
End Function
Cách tiếp theo có thể dùng đệ quy hoặc duyệt qua chuỗi. Nhìn chung bài này có nhiều cách giải quyết.
Cách giải trên đây vẫn chưa phải là tối ưu do vẫn có một số vòng lặp bị thửa (giả định như chuỗi không còn phần tử lặp thì nó vẫn cứ phải duyệt qua cả chuỗi).
Bài tập 03: Chuẩn hoá 1 chuỗi đầu vào theo nguyên tắc: Không tồn tại 2 ký tự liền kề giống nhau, các ký tự không liền kề vẫn có thể giống nhau. Ví dụ với chuỗi đầu vào là "AABBBBCCCCDDAAAAAA" thì chuỗi sau khi chuẩn hoá là "ABCDA"
Bài tập 03: Chuẩn hoá 1 chuỗi đầu vào theo nguyên tắc: Không tồn tại 2 ký tự liền kề giống nhau, các ký tự không liền kề vẫn có thể giống nhau. Ví dụ với chuỗi đầu vào là "AABBBBCCCCDDAAAAAA" thì chuỗi sau khi chuẩn hoá là "ABCDA"
Function ConverStr(Str As String) As String
Dim C As String
Str = Application.WorksheetFunction.Trim(vbBack & Str & vbBack)
Str = Replace(Str, " ", vbBack)
i = 2
Do Until i = Len(Str)
C = Mid(Str, i, 1)
If C <> vbBack Then Str = Replace(Application.WorksheetFunction.Trim(Replace(Str, C, " ")), " ", C)
i = i + 1
Loop
ConverStr = Replace(Mid(Str, 2, Len(Str) - 2), vbBack, " ")
End Function
Nếu không phân biệt chữ hoa, chữ thường thì thêm một dòng lệnh Convert cả chuỗi sang chữ hoa hoặc chữ thường.
Không phân biệt chữ hoa chữ thường nhưng kết quả trả về vẫn có chữ hoa và chữ thường tùy thuộc vào ký tự đầu tiên bị trùng lặp mà ta xét, ví dụ "aAABbbCCCdDdAa" thì kết quả là "aBCdA". Với yêu cầu đó thì có lẽ không dùng phương pháp này được.
Không phân biệt chữ hoa chữ thường nhưng kết quả trả về vẫn có chữ hoa và chữ thường tùy thuộc vào ký tự đầu tiên bị trùng lặp mà ta xét, ví dụ "aAABbbCCCdDdAa" thì kết quả là "aBCdA". Với yêu cầu đó thì có lẽ không dùng phương pháp này được.
Cứ For Next bình thường là được rồi
- Đặt 1 biến tạm
- Quét chuổi từ 1 đến Len(Chuổi)
- Nếu biến tạm <> ký tư thứ i thi
a> Lấy ký tự thứ i này ráp vào 1 chuổi tạm khác
b) Cho biến tạm = Ký tự thứ i
- Tiếp tục vòng lập
- Cuối cùng lấy kết quả chính là chuổi tạm khác
----------
Phân biệt HOA thường hay không, cùng lắm chỉ xét thêm UCase nữa là xong!
Các bạn làm trước theo hướng dễ: Có phân biệt HOA - thường rồi sau đó hẳn tính tiếp
Bài tập 02: Nhập vào 1 số N nguyên dương, in ra sheet hiện hành trên 1 vùng N cột, N dòng bắt đầu từ ô A1 với vùng đó chứa các số tự nhiên từ 1 đến N*N theo vòng xoáy ốc. Ví dụ N=5 ta sẽ phải in ra sheet hiện hành là
Tôi có một phương án cho bài tập này. Mời mọi người tham khảo.
PHP:
Sub Test()
Application.ScreenUpdating = False
Dim Rng As Range, Way As Boolean, Number As Long
ActiveSheet.UsedRange.Clear
Number = InputBox("Please enter your number:")
[A1].Value = 1
Set Rng = [B1]
Way = True
For i = 2 To Number * Number
Rng.Value = i
If Way Then
If Rng.Column = 1 Or Rng.Column = Number Then
Way = False
Set Rng = Rng.Offset(IIf(Rng.Column > (Number / 2 + 0.5), 1, -1))
ElseIf Rng.Offset(, IIf(Rng.Row < (Number / 2 + 0.5), 1, -1)).Value <> "" Then
Way = False
Set Rng = Rng.Offset(IIf(Rng.Column > (Number / 2 + 0.5), 1, -1))
Else
Set Rng = Rng.Offset(, IIf(Rng.Row > (Number / 2 + 0.5), -1, 1))
End If
Else
If Rng.Row = 1 Or Rng.Row = Number Then
Way = True
Set Rng = Rng.Offset(, IIf(Rng.Row > (Number / 2 + 0.5), -1, 1))
ElseIf Rng.Offset(IIf(Rng.Column > (Number / 2 + 0.5), 1, -1)).Value <> "" Then
Way = True
Set Rng = Rng.Offset(, IIf(Rng.Row > (Number / 2 + 0.5), -1, 1))
Else
Set Rng = Rng.Offset(IIf(Rng.Column > (Number / 2 + 0.5), 1, -1))
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Bài tập 03:
Chuẩn hoá 1 chuỗi đầu vào theo nguyên tắc: Không tồn tại 2 ký tự liền kề giống nhau, các ký tự không liền kề vẫn có thể giống nhau. Ví dụ với chuỗi đầu vào là "AABBBBCCCCDDAAAAAA" thì chuỗi sau khi chuẩn hoá là "ABCDA"
Public Function cat(Vung As Range) As String
Dim i As Integer, Tam As String, j As String
'Vung = UCase(Vung)'
For i = 2 To Len(Vung)
j = Mid(Vung, i, 1)
If Mid(Vung, i - 1, 1) = j Then j = ""
Tam = Tam & j
Next
cat = Left(Vung, 1) & Tam
End Function
Theo tôi với vòng lặp thì bài này có thể finish được rồi, 1 vòng lặp hay 2 vòng lặp thì số lượng phép toán là như nhau, các bạn có thể tìm hiểu thêm phương pháp không dùng vòng lặp(đệ quy) xem sao.
Liên quan đến vòng lặp thì thường là các bài liên quan đến xử lý mảng, sắp xếp, ma trận, xử lý chuỗi ... Tôi xin góp vui 1 bài như sau Bài tập 02: Nhập vào 1 số N nguyên dương, in ra sheet hiện hành trên 1 vùng N cột, N dòng bắt đầu từ ô A1 với vùng đó chứa các số tự nhiên từ 1 đến N*N theo vòng xoáy ốc. Ví dụ N=5 ta sẽ phải in ra sheet hiện hành là
Với các bạn mới học, hãy xé nhỏ ra từng đoạn:
Đoạn 1: fill ngang lần 1 (gặp cột thứ n thì ngừng)
Đoạn 2: fill xuống lần 1 (gặp dòng thứ n thì ngừng)
Đoạn 3: fill qua trái lần 1 (gặp cột 1 thì ngừng)
Đoạn 4: các số còn lại. Các số này có tính chất giống nhau là gặp ô có số thì đổi hướng.
Do dùng để hướng dẫn các bạn mới, nên không dùng mảng, không dùng thuật toán cao siêu, đơn giản select rồi gán số. Tô màu gì đó cho mỗi ô tạo chút hiệu ứng chạy.
Đoạn 1:
PHP:
For i = 1 To Num
With Cells(1, i)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Next
Quá dễ, đúng không?
Đoạn 2:
PHP:
For i = Num + 1 To Num * 2 - 1
With Cells(i - Num + 1, Num)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Next
Cũng còn dễ, chỉ cần suy luận 1 tí ti là chỉ có n - 1 số, từ n +1 đến 2n -1, số dòng dùng 1 phép cộng trừ đơn giản, cột là n.
Đoạn 3: suy luận tương tự, chỉ có n - 1 số, từ 2n đến 3n-2, dòng là n, cột thì cộng trừ tí ti.
PHP:
For i = Num * 2 To Num * 3 - 2
With Cells(Num, Num * 3 - i - 1)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Next
Đoạn 4:
Bắt đầu khó khăn. Trước khi select ô kế, phải dò trước xem ô đó có số chưa, nếu chưa thì chạy tới, nếu rồi thì đổi hướng.
PHP:
For i = Num * 3 - 1 To Num ^ 2
Hướng bắt đầu là hướng chạy lên, ô kế là Selection.Offset(-1, 0). Đặt 2 biến j và k và gán j = -1, k = 0
Điều kiện để đổi hướng chạy ngang qua phải:
PHP:
With Selection
If .Offset(j, k).Value > 0 And j = -1 Then j = 0: k = 1
Tiếp theo là chạy ngang qua phải, ô kế là Selection.Offset(0, 1). Điều kiện đổi hướng chạy xuống:
PHP:
If .Offset(j, k).Value > 0 And j = 0 Then j = 1: k = 0
Tương tự điều kiện đổi hướng chạy ngang qua trái:
PHP:
If .Offset(j, k).Value > 0 And j = 1 Then j = 0: k = -1
Cuối cùng là điều kiện đổi hướng chạy lên:
PHP:
If .Offset(j, k).Value > 0 And j = 0 Then j = -1: k = 0
End With
Bắt đầu select và gán số:
PHP:
With Selection.Offset(j, k)
.Select
.Value = i
.Interior.ColorIndex = 4
.Interior.ColorIndex = 4
End With
Next
Ráp lại, thêm 1 miếng Delay cho chạy từ từ thôi:
PHP:
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
PHP:
Sub quay1(ByVal Num As Long, Delay As Long)
Dim i As Long, j As Long, k As Long
ActiveSheet.Cells.Clear
For i = 1 To Num
With Cells(1, i)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Sleep Delay
Next
For i = Num + 1 To Num * 2 - 1
With Cells(i - Num + 1, Num)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Sleep Delay
Next
For i = Num * 2 To Num * 3 - 2
With Cells(Num, Num * 3 - i - 1)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Sleep Delay
Next
j = -1: k = 0
For i = Num * 3 - 1 To Num ^ 2
With Selection
If .Offset(j, k).Value > 0 And j = -1 Then j = 0: k = 1
If .Offset(j, k).Value > 0 And j = 0 Then j = 1: k = 0
If .Offset(j, k).Value > 0 And j = 1 Then j = 0: k = -1
If .Offset(j, k).Value > 0 And j = 0 Then j = -1: k = 0
End With
With Selection.Offset(j, k)
.Select
.Value = i
.Interior.ColorIndex = 4
.Interior.ColorIndex = 4
End With
Sleep Delay
Next
End Sub
Dùng 1 Command button để lấy số tuỳ ý và chạy code:
PHP:
Private Sub Cmb1_Click()
Num = InputBox("So may?")
On Error GoTo exit1
quay1 Num, 20
exit1:
Exit Sub
End Sub
Vẫn dùng select tới đâu, gán số tới đó. nhưng không chia đoạn nữa, như vậy điều kiện chuyển hướng nhiều hơn: Không phải chỉ thấy số thì đổi hướng, mà 3 đoạn đầu bài trên, cần điều kiện khác. Cộng là 7 điều kiện:
PHP:
Sub quay2(ByVal Num As Long, Delay As Long)
Dim i As Long, j As Long, k As Long
ActiveSheet.Cells.Clear
With ActiveSheet.[a1]
.Select
.Value = 1
.Interior.ColorIndex = 4
End With
j = 0: k = 1
For i = 2 To Num ^ 2
With Selection
If .Column = Num And j = 0 And k = 1 Then j = 1: k = 0
If .Row = Num And j = 1 And k = 0 Then j = 0: k = -1
If .Column = 1 And j = 0 And k = -1 Then j = -1: k = 0
If .Offset(j, k).Value > 0 And j = 0 And k = 1 Then j = 1: k = 0
If .Offset(j, k).Value > 0 And j = 1 And k = 0 Then j = 0: k = -1
If .Offset(j, k).Value > 0 And j = 0 And k = -1 Then j = -1: k = 0
If .Offset(j, k).Value > 0 And j = -1 And k = 0 Then j = 0: k = 1
End With
With Selection.Offset(j, k)
.Select
.Value = i
.Interior.ColorIndex = 4
End With
Sleep Delay
Next
End Sub
Và vì thuật toán là dò ô kế, đạt điều kiện là nhảy qua rồi gán số, nên sót ô đầu tiên chưa có số, phải gán ngay từ đầu code.
Xin cảm ơn tất cả các bạn đã tham gia ToPic này !
Tôi đang thử sức với các bài tập trên nhưng chỉ hiểu và làm được khoảng 30%. Là người thành tâm muốn theo học, tôi xin có một số ý kiến như sau:
Với chủ đề của Topic này là bài tập về vòng lặp và tập đi từ dễ đến khó thì:
1- Chỉ giải quyết bài tập bằng vòng lặp (các kiểu vòng lặp), nhằm tập trung cho mục tiêu không bàn đến các giải pháp không dùng vòng lặp.
2- Bài tập càng đơn giản càng tốt (vì mọi cái chưa biết đều là khó). Không nên đưa ra quá nhiều bài tập theo tôi mỗi tuần khoảng 2 đến 3 bài là vừa. Giai đoạn đầu (giai đoạn dễ) nên kéo dài ít nhất 4 tuần để người học còn có thời gian nghiên cứu, đúc rút kinh nghiệm và tự thực hành.
3- Nên có hướng dẫn chi tiết từng bước cho người học ví dụ như bài #26 của ptm0412.
4- Các bạn tham hướng dẫn giải bài tập, trong giai đoạn đầu cần chú ý viết sao cho bình dân (dễ hiểu nhất) các vấn đề về vòng lặp, chưa vội bàn đến giải pháp ngắn hay dài, tối ưu hay chưa tối ưu (vì là bài tập nên hiệu ích của bài viết chính là số lượng người hiểu bài).
Đúng là "được voi lại đòi cả người cưỡi voi" nhưng với những người như tôi nếu không được cả hai thì mọi cố gắng của các bạn đều như nước đổ lá khoai mà thôi.
Nếu có gì không phải mong các bạn bỏ qua và đề nghị Mod xóa giúp bài này nếu xét thấy là không cần thiết.
Thanks !
2- Bài tập càng đơn giản càng tốt (vì mọi cái chưa biết đều là khó). Không nên đưa ra quá nhiều bài tập theo tôi mỗi tuần khoảng 2 đến 3 bài là vừa. Giai đoạn đầu (giai đoạn dễ) nên kéo dài ít nhất 4 tuần để người học còn có thời gian nghiên cứu, đúc rút kinh nghiệm và tự thực hành.
Đồng ý với anh Trung Chinh!
Vậy xin mời các bạn làm lại bài 1 và bài 3, theo tôi 2 bài này cũng khá đơn giản! Lưu ý: Khi làm xong code, nếu có thể được, các bạn hãy đính kèm luôn file nhé (cho tiện việc kiểm tra) (xin đừng vì ngại người ta cười code của mình mà không tham gia nhé)
Bài 3 giải theo concogia có lẽ là ổn rồi, xin góp bài tập kế: Bài tập 04
Căn cứ vào câu lệnh tô màu và sleep trong bài 26, thử 3 câu như sau:
Chọn 1 vùng chữ nhật trong sheet, dài rộng không bằng nhau:
a. Tô màu từng ô, từng dòng từ trái qua phải, từ trên xuống dưới.
b. Tô màu từng dòng từ trái qua phải, rồi dòng kế ngược lại từ phải qua trái đến hết.
c. Tô màu caro kiểu bi da: Tô màu từng ô theo đường chéo 45 độ, gặp đường biên thì dội ra 45 độ hướng khác. Kết quả được 1 hình tô carô.
Tôi nghĩ nếu ai có giải pháp hay thì cứ post lên cho mọi người tham khảo kiểu như một cách giải khác thôi. Vì với một bài toán thì cách giải không dùng vòng lặp thường hay hơn cách giải dùng vòng lặp. Theo tôi đã học thì cái gì hay thì học, nhất là những bài giải mang tính sáng tạo.
Tôi nghĩ nếu ai có giải pháp hay thì cứ post lên cho mọi người tham khảo kiểu như một cách giải khác thôi. Vì với một bài toán thì cách giải không dùng vòng lặp thường hay hơn cách giải dùng vòng lặp. Theo tôi đã học thì cái gì hay thì học, nhất là những bài giải mang tính sáng tạo.
Bạn ơi! Đây là topic BÀI HỌC chứ không phải TÌM GIẢI PHÁP hay!
Đã gọi là HỌC thì mục đích làm sao cho mọi người HIỂU được mới xem là thành công!
Giống như bài toán của sư phụ pmt0412 đưa ra đấy thôi: Dùng vòng lập để tính giai thừa ---> Ai chả biết bài nào khỏi vòng lập cũng làm được! Vấn đề là THÔNG QUA BÀI TẬP ĐỂ HIỂU VÒNG LẬP bạn à!
Ý kiến của bạn cũng tốt, nhưng e rằng ta phải tìm hiểu trong 1 topic khác thôi!
Tôi xin bàn 1 chút về Bài tập 02, bài này mới đọc lên thì thấy rất khó, nhưng nếu hiểu rõ 1 chút về ma trận vuông thì bài này cũng không hẳn khó. Với 1 ma trận vuông cấp N sẽ có N dòng và N cột, giả sử các dòng và cột được đánh số từ 1 -> N, ta kẻ 2 đường chéo cho ma trận thì sẽ chia ma trận thành 4 vùng tương ứng là Trên, Dưới, Trái, Phải, tương ứng với mỗi vùng ta sẽ thấy, tại vùng Trên khi điền số theo thứ tự thì Cột tăng, tương tự vùng Dưới Cột giảm, vùng Phải Dòng tăng, vùng Trái Dòng giảm.Giờ ta xét 1 vài tính chất của ma trận này.
1. Đường chéo 1(màu tím): Tập hợp của các ô có Dòng=Cột
2. Đường chéo 2(màu xanh): Tập hợ của các ô có Dòng+Cột=N+1
3. Vùng nằm phía trên đường chéo 1: Tập hợp các ô có Cột > Dòng
4. Vùng nằm phía dưới đường chéo 1: Tập hợp các ô có Cột < Dòng
5. Vùng nằm phía trên đường chéo 2: Tập hợp các ô có Dòng+Cột < N+1
6. Vùng nằm phía dưới đường chéo 2: Tập hợp các ô có Dòng+Cột >N+1
Tập hợp các dữ kiện trên sẽ đưa ra được quy luật tương đối đơn giản, các bạn tham khảo đoạn code dưới đây nhé:
Mã:
Sub MaTran()
Dim n As Long
n = InputBox("Nhap cap ma tran: ")
Dim iRow As Long
Dim iCol As Long
Dim iValue As Long
Dim arr() As Long
ReDim arr(1 To n, 1 To n)
iCol = 1: iRow = 1
For iValue = 1 To n ^ 2
arr(iRow, iCol) = iValue
If (iCol >= iRow And iCol + iRow < n + 1) Or (iCol = iRow - 1 And iCol + iRow <= n + 1) Then
iCol = iCol + 1
ElseIf iCol > iRow And iCol + iRow >= n + 1 Then
iRow = iRow + 1
ElseIf iCol <= iRow And iCol + iRow > n + 1 Then
iCol = iCol - 1
ElseIf iCol < iRow - 1 And iCol + iRow <= n + 1 Then
iRow = iRow - 1
End If
Next
Range(Cells(1, 1), Cells(n, n)) = arr
End Sub
Bài 3 giải theo concogia có lẽ là ổn rồi, xin góp bài tập kế: Bài tập 04
Căn cứ vào câu lệnh tô màu và sleep trong bài 26, thử 3 câu như sau:
Chọn 1 vùng chữ nhật trong sheet, dài rộng không bằng nhau:
a. Tô màu từng ô, từng dòng từ trái qua phải, từ trên xuống dưới.
b. Tô màu từng dòng từ trái qua phải, rồi dòng kế ngược lại từ phải qua trái đến hết.
c. Tô màu caro kiểu bi da: Tô màu từng ô theo đường chéo 45 độ, gặp đường biên thì dội ra 45 độ hướng khác. Kết quả được 1 hình tô carô.
Lưu ý câu c: Không phải hình chữ nhật nào cũng có đáp án. Ví dụ một hình chữ nhật có dạng d-1=n(r-1) (với d là chiều dài, r là chiều rộng) chẳng hạn như: 5x9, 5x13, 6x11,... Khi test code các bạn nên bẫy lỗi cẩn thận để tránh rơi vào vòng lặp vô tận.
Lưu ý câu c: Không phải hình chữ nhật nào cũng có đáp án. Ví dụ một hình chữ nhật có dạng d-1=n(r-1) (với d là chiều dài, r là chiều rộng) chẳng hạn như: 5x9, 5x13, 6x11,... Khi test code các bạn nên bẫy lỗi cẩn thận để tránh rơi vào vòng lặp vô tận.
Nên chăng có những BT thực tế hơn, ví dụ như là, tính những ngày nghĩ từ nay đến -> 31/12/2012 bao gồm những ngày nghỉ bù, (nếu ngày lễ là CN, áp dụng cho tuần là 48h) chưa kể mấy ngày lễ tết. Tính trước để mình còn dự trù những ngày ăn chơi.
Giả sử ngày nghỉ là: 30/04, 01/05, 02/09, 01/01. Chưa kể mấy ngày nghỉ tết và 10/3 AL.
Nhờ BQT xóa bài hộ.
Ái chà! Bài này cũng đâu có dễ ăn! Nhất là đối với bạn mới học
Thà là vầy đi: Tính từ đầu năm đến cuối năm tôi đã đi làm được bao nhiều ngày (nghỉ CN và lễ, không tính nghỉ đột xuất)
Dễ hơn rất nhiều
Ẹc... Ẹc...
Vậy cứ thống nhất vậy nhé.
Từ 19/08/2010 - 31/12/2010 mình sẽ làm việc bao nhiêu ngày. Ngày lễ gồm có: 2/9 và ngày nghỉ là CN. Và liệt kê những ngày thứ hai gán vào A1->An của 1 sheet. Dòng vòng lặp thông thường.
Bài 3 giải theo concogia có lẽ là ổn rồi, xin góp bài tập kế: Bài tập 04
Căn cứ vào câu lệnh tô màu và sleep trong bài 26, thử 3 câu như sau:
Chọn 1 vùng chữ nhật trong sheet, dài rộng không bằng nhau:
a. Tô màu từng ô, từng dòng từ trái qua phải, từ trên xuống dưới.
b. Tô màu từng dòng từ trái qua phải, rồi dòng kế ngược lại từ phải qua trái đến hết.
c. Tô màu caro kiểu bi da: Tô màu từng ô theo đường chéo 45 độ, gặp đường biên thì dội ra 45 độ hướng khác. Kết quả được 1 hình tô carô.
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Câu a:
Mã:
Sub tomau1()
Dim i As Long, j As Long
For i = 1 To 5
For j = 1 To 7
Cells(i, j).Interior.ColorIndex = 4
Sleep 100
Next j
Next i
End Sub
Câu b:
Mã:
Sub tomau2()
Dim i As Long, j As Long
For i = 9 To 14
If i Mod 2 <> 0 Then
For j = 1 To 7
Cells(i, j).Interior.ColorIndex = 4
Sleep 100
Next j
ElseIf i Mod 2 = 0 Then
For j = 7 To 1 Step -1
Cells(i, j).Interior.ColorIndex = 3
Sleep 100
Next j
End If
Next i
End Sub
Sub tomau2()
Dim i As Long, j As Long
For i = 9 To 14
If i Mod 2 <> 0 Then
For j = 1 To 7
Cells(i, j).Interior.ColorIndex = 4
Sleep 100
Next j
ElseIf i Mod 2 = 0 Then
For j = 7 To 1 Step -1
Cells(i, j).Interior.ColorIndex = 3
Sleep 100
Next j
End If
Next i
End Sub
Với câu b) tôi xin gợi ý thế này
- Dùng 2 vòng lập, 1 cái quét theo dòng và 1 cái quét theo cột... Đại khái thế này:
PHP:
Dim SrcRng as Range, iR as Long, iC as Long
Set SrcRng = Selection
For iR = 1 To SrcRng.Rows.Count
For iC = 1 to SrcRng.Columns.Count Step 1
Trong code này, phần quét theo cột đang theo chiều thuận (từ trái sang phải)... Nếu muốn theo chiều ngược lại thì
PHP:
Dim SrcRng as Range, iR as Long, iC as Long
Set SrcRng = Selection
For iR = 1 To SrcRng.Rows.Count
For SrcRng.Columns.Count to 1 Step -1
- Để ý thấy 2 code trên chỉ khác nhau 1 tí (đảo 1 và SrcRng.Columns.Count với nhau và khác Step)
- Sự thay đổi này hoàn toàn tùy thuộc và vị trí của dòng (iR)
- Vậy ta có thể đặt thêm vài biến nữa để nhận biết được sự thay đổi này
PHP:
Dim iR As Long, iC As Long, SrcRng As Range, Chk As Boolean, Col As Long, Stp As Long, Color As Long
Set SrcRng = Selection
Col = SrcRng.Columns.Count
For iR = 1 To SrcRng.Rows.Count
Chk = iR Mod 2
Stp = IIf(Chk, 1, -1)
Color = IIf(Chk, 4, 3)
For iC = IIf(Chk, 1, Col) To IIf(Chk, Col, 1) Step Stp
With SrcRng.Cells(iR, iC)
.Select
.Interior.ColorIndex = Color
End With
Sleep 100
Next
Next
Việc thể hiện code là tùy theo ý của mỗi người, miễn sao dễ nhìn là được!
Sau này, nếu trình độ khá hơn 1 chút, bạn có thể viết code theo kiểu có tham số truyền như thế này
PHP:
Private Sub RangeColor(SrcRng As Range, Color1 As Long, Color2 As Long, Delay As Long)
Dim iR As Long, iC As Long, Chk As Boolean, Col As Long, Stp As Long
Col = SrcRng.Columns.Count
For iR = 1 To SrcRng.Rows.Count
Chk = iR Mod 2
Stp = IIf(Chk, 1, -1)
For iC = IIf(Chk, 1, Col) To IIf(Chk, Col, 1) Step Stp
With SrcRng.Cells(iR, iC)
.Select
.Interior.ColorIndex = IIf(Chk, Color1, Color2)
End With
Sleep Delay
Next
Next
End Sub
Rồi khi cần chạy ứng dụng, ta viết 1 đoạn khác ngắn gọn hơn:
PHP:
Sub Test()
RangeColor Selection, 3, 4, 100
End Sub
Một vài gợi ý nhỏ, hy vọng có thể giúp ích cho các bạn
Câu b Em làm theo cách hướng dẫn của Anh và cách hiểu của mình thay cho cách chọn số dòng số cột ở trước.
Mã:
[COLOR=#0000bb]Private Declare Sub Sleep Lib "[/COLOR][COLOR=red]kernel32[/COLOR][COLOR=#0000bb]" (ByVal ms As Long)[/COLOR]
[COLOR=#0000bb]Sub Test()[/COLOR]
[COLOR=#0000bb]Dim iR As Long, iC As Long, SrcRng As Range[/COLOR]
[COLOR=#0000bb]Set SrcRng = Selection[/COLOR]
[COLOR=#0000bb] For iR = 1 To SrcRng.Rows.Count[/COLOR]
[COLOR=#0000bb] If iR Mod 2 <> 0 Then[/COLOR]
[COLOR=#0000bb] For iC = 1 To SrcRng.Columns.Count[/COLOR]
[COLOR=#0000bb] SrcRng.Cells(iR, iC).Interior.ColorIndex = 4[/COLOR]
[COLOR=#0000bb] Sleep 50[/COLOR]
[COLOR=#0000bb] Next[/COLOR]
[COLOR=#0000bb] ElseIf iR Mod 2 = 0 Then[/COLOR]
[COLOR=#0000bb] For iC = SrcRng.Columns.Count To 1 Step -1[/COLOR]
[COLOR=#0000bb] SrcRng.Cells(iR, iC).Interior.ColorIndex = 3[/COLOR]
[COLOR=#0000bb] Sleep 50[/COLOR]
[COLOR=#0000bb] Next[/COLOR]
[COLOR=#0000bb] End If[/COLOR]
[COLOR=#0000bb] Next[/COLOR]
[COLOR=#0000bb]End Sub[/COLOR]
Câu b Em làm theo cách hướng dẫn của Anh và cách hiểu của mình thay cho cách chọn số dòng số cột ở trước.
Mã:
[COLOR=#0000bb]Private Declare Sub Sleep Lib "[/COLOR][COLOR=red]kernel32[/COLOR][COLOR=#0000bb]" (ByVal ms As Long)[/COLOR]
[COLOR=#0000bb]Sub Test()[/COLOR]
[COLOR=#0000bb]Dim iR As Long, iC As Long, SrcRng As Range[/COLOR]
[COLOR=#0000bb]Set SrcRng = Selection[/COLOR]
[COLOR=#0000bb] For iR = 1 To SrcRng.Rows.Count[/COLOR]
[COLOR=#0000bb] If iR Mod 2 <> 0 Then[/COLOR]
[COLOR=#0000bb] For iC = 1 To SrcRng.Columns.Count[/COLOR]
[COLOR=#0000bb] SrcRng.Cells(iR, iC).Interior.ColorIndex = 4[/COLOR]
[COLOR=#0000bb] Sleep 50[/COLOR]
[COLOR=#0000bb] Next[/COLOR]
[COLOR=#0000bb] ElseIf iR Mod 2 = 0 Then[/COLOR]
[COLOR=#0000bb] For iC = SrcRng.Columns.Count To 1 Step -1[/COLOR]
[COLOR=#0000bb] SrcRng.Cells(iR, iC).Interior.ColorIndex = 3[/COLOR]
[COLOR=#0000bb] Sleep 50[/COLOR]
[COLOR=#0000bb] Next[/COLOR]
[COLOR=#0000bb] End If[/COLOR]
[COLOR=#0000bb] Next[/COLOR]
[COLOR=#0000bb]End Sub[/COLOR]
Câu b) này dù đã sửa lại nhưng đếm trong code sẽ thấy có 3 vòng lập ---> Vì thế mà tôi mới hướng dẩn bạn rút gọn lại chỉ còn 2 vòng lập thôi
Thử để ý xem code này:
PHP:
For iC = 1 To SrcRng.Columns.Count
SrcRng.Cells(iR, iC).Interior.ColorIndex = 4
Sleep 50
Next
Và đoạn này:
PHP:
For iC = SrcRng.Columns.Count To 1 Step -1
SrcRng.Cells(iR, iC).Interior.ColorIndex = 3
Sleep 50
Next
Có khác nhau gì mấy đâu ---> Sao không gộp làm 1?
-----------------------------------------------------------
Câu c) khó quá thì... cứ từ từ... Xem bài Trái Bi-a này cũng giống đấy!
Vậy cứ thống nhất vậy nhé.
Từ 19/08/2010 - 31/12/2010 mình sẽ làm việc bao nhiêu ngày. Ngày lễ gồm có: 2/9 và ngày nghỉ là CN. Và liệt kê những ngày thứ hai gán vào A1->An của 1 sheet. Dòng vòng lặp thông thường.
Sub lamviec()
Dim i As Integer, j As Integer, k As Integer, dk As Boolean
Dim ngayle As Integer, ngaynghi As Integer, ngaylam As Long
ngayle = 1: ngaynghi = 0
For i = 8 To 12
dk = i Mod 8
k = IIf(dk, 1, 19)
For j = k To 31
With [COLOR=Red]ActiveCell[/COLOR]
If Weekday(DateSerial(2010, i, j)) = 1 Then
ngaynghi = ngaynghi + 1
.Value = DateSerial(2010, i, j)
.Offset(1, 0).Select
End If
End With
Next j
Next i
ngaylam = DateSerial(2010, 12, 31) - DateSerial(2010, 8, 19) - ngayle - ngaynghi
MsgBox "Tong ngay lam viec la: " & ngaylam
End Sub
Điều kiện đưa vào bắt đầu cells(1,1) Em chưa biết, nên dùng Activecell thì nó mới chạy, mong các Anh giúp.
Bằng cách dùng cells(i , j) với gia số dòng K và gia số cột L với điều kiện:
Nếu j = tổng số cột hoặc j=1, i tăng lên 1, ta cho gia số dòng k = 0 sau đó tăng k = k + 1
khi tô màu từ trái qua phải, j tăng 1 đến khi bằng tổng số cột thì ngưng, xuống dòng.
khi tô từ phải qua trái, j giảm 1 đến khi bằng 1 thì ngưng, xuống dòng.
Vậy ta cho gia số cột L = 1 và khi thoả điều kiện, L = - L (đổi dấu)
Vòng lặp chạy từ 1 đến tích số dòng và cột. Lưu ý rằng j có những mốc không tăng, không giảm, đó là khi vừa xuống dòng.
Để tô 2 màu xen kẽ, ta đặt điều kiện cho gia số k, nếu k Mod 2 = 0 thì tô màu này, ngược lại thì tô màu kia.
PHP:
Sub tomau2()
Dim i As Long, j As Long, k As Long, L As Long, t As Long
Dim CRows As Long, CCols As Long
Cells.Clear
k = 0: L = 1
i = 1: j = 0: t = 0
On Error GoTo exit1
CRows = InputBox("So dong?")
CCols = InputBox("So cot?")
For t = 1 To CRows * CCols
Cells(i + k, j + L).Interior.ColorIndex = IIf(k Mod 2 = 0, 28, 3)
j = j + L
If t Mod CCols = 0 And t < CRows * CCols Then
k = k + 1
Cells(i + k, j).Interior.ColorIndex = IIf(k Mod 2 = 0, 28, 3)
t = t + 1
L = -L
End If
Sleep 20
Next
exit1:
Exit Sub
End Sub
Hai vòng lặp không phải là dở, nhưng bằng biện pháp dùng gia số dòng cột này, hãy nghĩ đến câu c.
Nếu hiểu rõ về ma trận thì cả 2 câu này không khó, chỉ cần duy nhất 1 vòng lặp từ 1 đến Dòng*Cột là xong. Tôi gợi ý 1 chút như sau, với cả 2 câu đều thực hiện giống nhau, với mỗi bước của vòng lặp, xác định biến Dòng và Cột từ biến chạy, xử lý cho cell tương ứng với Dòng và Cột vừa tính được.
Theo gợi ý của RollOver (chuyên gia mảng), câu a làm lại như sau: (thủ thuật tương tự bài ma phương)
PHP:
Sub tomau1()
Dim i As Long, j As Long
Dim CRows As Long, CCols As Long
Cells.Clear
CRows = InputBox("So dong?")
CCols = InputBox("So cot?")
For t = 1 To CRows * CCols
i = Int((t - 1) / CCols) + 1
j = IIf(t Mod CCols = 0, CCols, t Mod CCols)
Cells(i, j).Interior.ColorIndex = IIf(i Mod 2 = 0, 3, 4)
Sleep 50
Next
End Sub
Đây là thủ thuật biến mảng 1 chiều thành mảng 2 chiều. Nếu là gán số xuống vùng vừa tô thì như sau:
Thêm câu lệnh gọi vào sub tomau1:
PHP:
Ganso CRows, CCols
PHP:
Sub Ganso(CRows As Long, CCols As Long)
Dim Arr()
ReDim Arr(1 To CRows, 1 To CCols)
For t = 1 To CRows * CCols
i = Int((t - 1) / CCols) + 1
j = IIf(t Mod CCols = 0, CCols, t Mod CCols)
Arr(i, j) = t
Next
Range(Cells(1, 1), Cells(CRows, CCols)) = Arr
End Sub
câu c bài 04, để tránh trường hợp tô hoài không hết như huuthang_bd cảnh báo, xin giới hạn đề bài thành 1 hình chữ nhật cụ thể 15 dòng, 24 cột cho các bạn mới học dễ làm.
câu c bài 04, để tránh trường hợp tô hoài không hết như huuthang_bd cảnh báo, xin giới hạn đề bài thành 1 hình chữ nhật cụ thể 15 dòng, 24 cột cho các bạn mới học dễ làm.
Không cần đâu sư phụ à! Chỉ cần trong quá trình tô màu mà có lập lại ít nhất 1 cell đã tô thì ... THOÁT ---> Đơn giản mà!
Tóm lại: Vùng cần tô màu = Selection (với Selection là 1 vùng liên tục)
Không đâu ndu à, khi trái bi da lăn, ai cấm nó lăn cắt ngang đường cũ chứ? Mà không cho nó lăn cắt ngang (vừa đụng vào đướng cũ là thoát) làm sao nó chạy qua hết tất cả các ô cần thiết?
Không đâu ndu à, khi trái bi da lăn, ai cấm nó lăn cắt ngang đường cũ chứ? Mà không cho nó lăn cắt ngang (vừa đụng vào đướng cũ là thoát) làm sao nó chạy qua hết tất cả các ô cần thiết?
Sư phụ chỉ cần xét 4 đường biên là được rồi ---> Bên trong không cần!
Nếu rơi vào vòng lập vô hạn thì chắc chắn nó phải "đạp" vào 1 cell nào đó (tại đường biên) mà nó đã từng đi qua
câu c bài 04, để tránh trường hợp tô hoài không hết như huuthang_bd cảnh báo, xin giới hạn đề bài thành 1 hình chữ nhật cụ thể 15 dòng, 24 cột cho các bạn mới học dễ làm.
Nếu xuất phát từ 1 góc của hình chữ nhật thì khi lăn đến một trong 3 góc còn lại của hình chữ nhật thì coi như trái banh đã lăn qua tất cả các điểm có thể đi qua. Dù có tô hết hay chưa, nếu có lăn tiếp thì cũng lặp lại quỹ đạo cũ. Vì vậy có thể dựa vào đặc điểm này để làm điều kiện thoát vòng lặp.
Vậy cứ thống nhất vậy nhé.
Từ 19/08/2010 - 31/12/2010 mình sẽ làm việc bao nhiêu ngày. Ngày lễ gồm có: 2/9 và ngày nghỉ là CN. Và liệt kê những ngày thứ hai gán vào A1->An của 1 sheet. Dòng vòng lặp thông thường.
Với yêu cầu dạng này dùng vòng lặp là làm chơi thôi, có thể không cần dùng vòng lặp cũng ra được kết quả vì nó có quy luật rõ ràng. Ngày làm=Tổng số ngày-Ngày nghỉ. Tính ngày nghỉ thì xác định ngày nghỉ cuối cùng, ngày nghỉ đầu tiên kết hợp thêm con số 7 nữa là ra. Các ngày nghỉ đặc biệt thì chỉ cần kiểm tra có thuộc khoảng xét hay không nữa là xong.
Với yêu cầu dạng này dùng vòng lặp là làm chơi thôi, có thể không cần dùng vòng lặp cũng ra được kết quả vì nó có quy luật rõ ràng. Ngày làm=Tổng số ngày-Ngày nghỉ. Tính ngày nghỉ thì xác định ngày nghỉ cuối cùng, ngày nghỉ đầu tiên kết hợp thêm con số 7 nữa là ra. Các ngày nghỉ đặc biệt thì chỉ cần kiểm tra có thuộc khoảng xét hay không nữa là xong.
Vâng! Nhưng cũng như tôi đã nói ở lần trước: Chúng ta đang tập tành với vòng lập ---> Vậy thì cứ quét từ ngày đầu đến ngày cuối và xét điều kiện đi ---> Đâu có vấn đề gì chứ
(Chứ để làm bài này thì công thức cũng xong)
Bác này chỉ xúi không à. Bài tập về vòng lặp thì cũng nên đi tư cơ bản đã, dạng như quy nạp, vậy cứ xét từ ngày đầu đền ngày cuối. Sau khi làm xong thấy cũng hay, ngồi nghĩ lại sao mà vòng này chạy nhiều quá tốn xăng, => mới nghiệm lại có thể nào bớt vòng đi. Chưa gì Bác đã gợi ý, có khi các bạn lại thích vòng lặp kiểu khác sao. Và nhất là phải liệt kê những ngày nghỉ nữa.
Em xin có ngu ý như vậy. Các bạn nếu muốn học VBA sao không xem đây là cơ hội. Thử viết xem 1 code như trên hoàn chỉnh, mình tin chắc sẽ có những cao nhân như Bac SA_DQ, Ndu, RollOver, HuuThang, PTM sẽ hướng dẫn và trau chuốt thêm. Chắc chắn sẽ có ích.
Về bài 4 câu C, tôi xin đưa lên 1 file ví dụ tạo khí thế cho các bạn nghiên cứu, xin được đưa code lên sau, do đó tạm thời tôi protect code(dĩ nhiên là protect VBA không ý nghĩa gì với các cao thủ cả ).
Chạy macro test trong file này sẽ cho phép nhập vào số Dòng, số Cột(kích thước nào cũng thực hiện tô hết), thực hiện bắt đầu tô từ 1 ô ngẫu nhiên trong vùng và tiến về hướng ngẫu nhiên trong 4 hướng. Nếu kích thước phù hợp sẽ thực hiện tô 1 lần đến hết, nếu kích thước thuộc trường hợp bị lặp lại thì khi nào phát hiện lặp lại thì sẽ thực hiện tô từ 1 ô ngẫu nhiên trong số ô chưa tô theo hướng ngẫu nhiên.
Về bài 4 câu C, tôi xin đưa lên 1 file ví dụ tạo khí thế cho các bạn nghiên cứu, xin được đưa code lên sau, do đó tạm thời tôi protect code(dĩ nhiên là protect VBA không ý nghĩa gì với các cao thủ cả ).
Chạy macro test trong file này sẽ cho phép nhập vào số Dòng, số Cột(kích thước nào cũng thực hiện tô hết), thực hiện bắt đầu tô từ 1 ô ngẫu nhiên trong vùng và tiến về hướng ngẫu nhiên trong 4 hướng. Nếu kích thước phù hợp sẽ thực hiện tô 1 lần đến hết, nếu kích thước thuộc trường hợp bị lặp lại thì khi nào phát hiện lặp lại thì sẽ thực hiện tô từ 1 ô ngẫu nhiên trong số ô chưa tô theo hướng ngẫu nhiên.
Về bài 4 câu C, tôi xin đưa lên 1 file ví dụ tạo khí thế cho các bạn nghiên cứu, xin được đưa code lên sau, do đó tạm thời tôi protect code(dĩ nhiên là protect VBA không ý nghĩa gì với các cao thủ cả ).
Chạy macro test trong file này sẽ cho phép nhập vào số Dòng, số Cột(kích thước nào cũng thực hiện tô hết), thực hiện bắt đầu tô từ 1 ô ngẫu nhiên trong vùng và tiến về hướng ngẫu nhiên trong 4 hướng. Nếu kích thước phù hợp sẽ thực hiện tô 1 lần đến hết, nếu kích thước thuộc trường hợp bị lặp lại thì khi nào phát hiện lặp lại thì sẽ thực hiện tô từ 1 ô ngẫu nhiên trong số ô chưa tô theo hướng ngẫu nhiên.
Xem kỹ lại code của rollover79 mới thấy để giải quyết bài này cho chuẩn thật chẳng đơn giản tí nào
- Chuẩn có nghĩa là tô ca rô toàn bộ vùng chọn, bất kể vùng ấy thế nào
- Dùng phép di chuyển như trái bi-a thì đương nhiên sẽ có trường hợp nào đó rơi vào vòng lập vô hạn dù ca rô chưa được tô hết
- Vậy, đối với trường hợp này ta phải thay đổi vị trí của ActiveCell thế nào đó sao cho bảo đảm tô màu ca rô toàn bộ
--------------------
Hay! nhưng mà với các bạn mới học vòng lập e rằng hơi quá sức chăng?
Xem kỹ lại code của rollover79 mới thấy để giải quyết bài này cho chuẩn thật chẳng đơn giản tí nào
- Chuẩn có nghĩa là tô ca rô toàn bộ vùng chọn, bất kể vùng ấy thế nào
- Dùng phép di chuyển như trái bi-a thì đương nhiên sẽ có trường hợp nào đó rơi vào vòng lập vô hạn dù ca rô chưa được tô hết
- Vậy, đối với trường hợp này ta phải thay đổi vị trí của ActiveCell thế nào đó sao cho bảo đảm tô màu ca rô toàn bộ
--------------------
Hay! nhưng mà với các bạn mới học vòng lập e rằng hơi quá sức chăng?
Vậy tôi mới phải protect code lại, chỉ là tạo thêm hứng thú cho các bạn khác nghiên cứu thêm thôi mà. Còn bình thường thì đúng như bác ptm nói, không hề phức tạp, thậm chí rất đơn giản chỉ vài dòng code là xong. Còn code của tôi thì nó không đơn giản chỉ là về vấn đề vòng lặp, còn có khá nhiều vấn đề trong đó nữa mà có thể ta sẽ gặp trong các bài toán khác.
Em sửa lại đoạn code theo hướng dẫn của Bác HYen17 như sau:
Mã:
Sub Tinhngay()
Dim tongngay As Long, nghi As Integer, le As Integer
Dim i As Long, j As Date
Cells.Clear
tongngay = DateSerial(2010, 12, 31) - DateSerial(2010, 8, 19)
le = 1: nghi = 0
For i = 19 To 26
If Weekday(DateSerial(2010, 8, i)) = 1 Then
For j = DateSerial(2010, 8, i) To DateSerial(2010, 12, 31) Step 7
With ActiveCell
.Value = j
nghi = nghi + ActiveCell.Count
.Offset(1, 0).Select
End With
Next
End If
Next
If Weekday(DateSerial(2010, 9, 2)) <> 1 Then ActiveCell = DateSerial(2010, 9, 2)
MsgBox "Tong ngay lam viec la: " & tongngay - le - nghi
End Sub
(*) Sau lại nhốt chung vòng lặp sau vô trong vòng lặp trước vậy?
Nếu gặp ngay ngày CN từ đầu, có fải bạn fí fạm 6 lần lặp không cần thiết không nào?
Nên thoát khỏi nó ngay khi gặp ngày CN chứ; Tuy thêm 1 dòng lệnh, nhưng thưởng giảm đi được khoảng gần nữa đọan đường trong vòng lặp thứ nhật đó bạn.
Em sửa lại đoạn code theo hướng dẫn của Bác HYen17 như sau:
Mã:
Sub Tinhngay()
Dim tongngay As Long, nghi As Integer, le As Integer
Dim i As Long, j As Date
Cells.Clear
tongngay = DateSerial(2010, 12, 31) - DateSerial(2010, 8, 19)
le = 1: nghi = 0
For i = 19 To 26
If Weekday(DateSerial(2010, 8, i)) = 1 Then
For j = DateSerial(2010, 8, i) To DateSerial(2010, 12, 31) Step 7
With ActiveCell
.Value = j
nghi = nghi + ActiveCell.Count
.Offset(1, 0).Select
End With
Next
End If
Next
If Weekday(DateSerial(2010, 9, 2)) <> 1 Then ActiveCell = DateSerial(2010, 9, 2)
MsgBox "Tong ngay lam viec la: " & tongngay - le - nghi
End Sub
Đây là code liệt kê tất cả những ngày đi làm ra cột A, từ đầu năm 2010 đến cuối năm 2010 (không tính chủ nhât)
PHP:
Sub Tinhngay()
Dim i As Long, j As Long
With Range("A:A")
.ClearContents
.NumberFormat = "dd/mm/yyyy"
For i = DateSerial(2010, 1, 1) To DateSerial(2010, 12, 31)
If Weekday(i, 1) > 1 Then
j = j + 1
.Cells(j, 1) = i
End If
Next
End With
End Sub
Code này chưa tính đến nghỉ lễ ---> Bạn cứ cải tiến nhé
(Nhìn qua nhìn lại chỉ thấy có mỗi bạn MinhCong ---> cái vụ VBA này xem ra ít người khoái nhỉ?)
Buồn quá, và ngứa ngáy nữa, nên đành post câu c bài 04 lên để tham khảo.
Như đã gợi ý ở câu b, ta dùng 1 gia số dòng và 1 gia số cột.
Xin giải thích 1 tẹo về chạy ca rô: Chạy ca rô là chạy ô vừa lên hoặc xuống, vừa chạy qua phải (hoặc trái), mỗi lần dịch chuyển 1 vị trí dòng và 1 vị trí cột. Xuống thì chỉ số dòng tăng và ngược lại. Qua phải thì chỉ số cột tăng và ngược lại.
Vậy gia số thêm vào cho dòng và cột là các số 1 và -1.
Trước tiên tô màu ô trên cùng bên trái vị trí là dòng i = 1 cột j = 1, hướng đi xuống về bên phải, gia số dòng K = 1 và gia số cột L = 1:
PHP:
i = 1: j = 1
K = 1, L = 1
Cells (i, j).Interior.ColorIndex = 15
Ô kế tiếp có vị trí dòng và cột là i = i + K, j = j + L
Nếu sau khi tô, vị trí ô vừa tô là cạnh rìa của hình chữ nhật, thì đổi chiều:
- Đụng cạnh rìa bên phải: L đổi từ 1 thành -1 để chạy qua trái
- Đụng cạnh rìa bên trái: L đổi từ -1 thành 1 để chạy qua phải
- Đụng cạnh dưới: K đổi từ 1 thành -1 để chạy lên
- Đụng cạnh trên: K đổi từ -1 thành 1 để chạy xuống.
Chưa cần tính tối ưu code làm gì, và cũng chưa cần bẫy lỗi làm gì, bạn đã có 1 đoạn code hoàn chỉnh và ngắn gọn. Với hình chữ nhật không đặc biệt (nghĩa là không bị trả về quỹ đạo cũ), bảo đảm sẽ tô toàn bộ khung chữ nhật thành carô.
Vậy tô bao nhiêu ô? Theo lý thuyết thì tô 1/2 tổng số ô, nhưng do chạy kiểu này, mỗi ô là 1 giao điểm của 2 đường chéo nên sẽ bị chạy qua 2 lần. Vậy Chọn số vòng lặp là tổng số ô và = dòng x cột. Có thể dư, có thể thiếu, nhưng tạm xài.
Code sau đây tô hình chữ nhật không đặc biệt 15 x 24:
PHP:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
______________________________________
Sub colorRun()
i = 1: j = 1
K = 1: L = 1
For d = 1 To 15 * 24
Sleep (15)
Cells(i, j).Interior.ColorIndex = 15
i = i + K
j = j + L
If i = 15 Or i = 1 Then K = -K
If j = 24 Or j = 1 Then L = -L
Next
End Sub
1. Xin hỏi trường hợp code của anh số hàng bằng số cột thì tô màu chỉ có 1 đường chéo
2. Xin anh giải thích giúp đoạn code: Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Không phải đâu anh, chẳng qua chưa làm được thì chưa post lên thôi, nhưng theo dõi và học tập thường xuyên, kính mong mấy anh giúp đỡ, đây là lớp học thuận tiên nhất
Cảm ơn các anh rất nhiều, chúc các anh luôn khỏe.
2. Mở rộng tô hình chữ nhật lấy kích thước từ bàn phím: (Hình đặc biệt vẫn chưa bẫy lỗi, lỗi gì thì thử nhiều kích thước khác nhau sẽ thấy)
PHP:
Sub colorRun1()
CRows = InputBox("So dong?")
CCols = InputBox("So cot?")
If CRows = 1 Or CCols = 1 Then Exit Sub
i = 1: j = 1
K = 1: L = 1
For d = 1 To CRows * CCols
Sleep (15)
Cells(i, j).Interior.ColorIndex = 15
i = i + K
j = j + L
If i = CRows Or i = 1 Then K = -K
If j = CCols Or j = 1 Then L = -L
Next
End Sub
3. Mở rộng tô vùng chọn bất kỳ không phải bắt đầu từ A1: (vẫn chưa sửa gì cho hình chữ nhật đặc biệt)
PHP:
Sub colorRun2()
CRows = Selection.Rows.Count
CCols = Selection.Columns.Count
If CRows = 1 Or CCols = 1 Then Exit Sub
i = 1: j = 1
K = 1: L = 1
For d = 1 To CRows * CCols
Sleep (15)
With Selection
.Cells(i, j).Interior.ColorIndex = 15
i = i + K
j = j + L
If i = CRows Or i = 1 Then K = -K
If j = CCols Or j = 1 Then L = -L
End With
Next
End Sub
Mọi người thử so sánh với code của mình làm xem? (Code của ndu và huuthang cũng chưa tô hết cho hình đặc biệt)
1. Xin hỏi trường hợp code của anh số hàng bằng số cột thì tô màu chỉ có 1 đường chéo
2. Em chạy thấy báo lỗi dòng Sleep(15): Xin anh giải thích giúp
Camr ơn anh
Như đã nói từ đầu topic, làm từ dễ đến khó, bẫy lỗi cho mọi hình chữ nhật không phải đơn giản, mới chỉ có mình RollOver đưa file lên tô hình chữ nhật bất kỳ, ndu và Huuthang cũng chưa. Trước mắt suy luận chuyện dễ trước.
Lỗi dòng Sleep do có lẽ viehoai không copy dòng khai báo trên cùng. Tải file bài trên nhé.
CRows * CCols
hay 24*15
Con số này bạn lây ở đâu ra vậy, hình như vừa thừa vừa thiếu? đây là số hay, tôi mới tiếp xúc VBA , không biết nên hỏi, nếu không đúng, thì bỏ qua
tôi cũng bị lỗi giống thế, vậy hàm Sleep này mình nghĩ ra, hãy viết ở đâu?
Chưa cần tính tối ưu code làm gì, và cũng chưa cần bẫy lỗi làm gì, bạn đã có 1 đoạn code hoàn chỉnh và ngắn gọn. Với hình chữ nhật không đặc biệt (nghĩa là không bị trả về quỹ đạo cũ), bảo đảm sẽ tô toàn bộ khung chữ nhật thành carô.
Vậy tô bao nhiêu ô? Theo lý thuyết thì tô 1/2 tổng số ô, nhưng do chạy kiểu này, mỗi ô là 1 giao điểm của 2 đường chéo nên sẽ bị chạy qua 2 lần. Vậy Chọn số vòng lặp là tổng số ô và = dòng x cột. Có thể dư, có thể thiếu, nhưng tạm xài.
Vậy nên tôi lấy tổng số ô = dài x rộng dùng làm số lần lặp.
Vì vẫn có 1 số ô nằm trên rìa hình chữ nhật không được tô 2 lần, nên hơi dư. Nếu không tô hết thì dư khá nhiều. Tuy vậy, không đến nỗi phải ngồi chờ suông lâu quá.
Hàm sleep là lấy trong thư viện Office ra, nó không có sẵn trong VBA nên phải khai báo đến thư viện (Lib) Kernel32.dll
mục đích dùng hàm này là để Pause code 1 khoảng thời gian tính bằng milisecond.
Em xin mạnh dạng đưa code, xin các anh chị giúp đỡ:
1. Chọn cell để xác định hàng và cột cuối cùng của vùng cần tô màu nền caro --> chạy code
2. (phần hỏi) Để tô nền caro cho một range bất kỳ (không xuất phát A1) bằng cách quét chọn range bất kỳ nào đó. Muốn vậy cần xác định hàng và cột đầu tiên của Range đó bằng cách nào? (cell đầu tiên của Range đang chọn). Xin các anh chị giúp đỡ
Cảm ơn các anh chị.
Em xin mạnh dạng đưa code, xin các anh chị giúp đỡ:
1. Chọn cell để xác định hàng và cột cuối cùng của vùng cần tô màu nền caro --> chạy code
2. (phần hỏi) Để tô nền caro cho một range bất kỳ (không xuất phát A1) bằng cách quét chọn range bất kỳ nào đó. Muốn vậy cần xác định hàng và cột đầu tiên của Range đó bằng cách nào? (cell đầu tiên của Range đang chọn). Xin các anh chị giúp đỡ
Cảm ơn các anh chị.
Viehoai có thể thử sửa code cho vùng chọn bất kỳ. Dù không phải tô kiểu bida, nhưng kết quả cũng là tô carô. Coi như bài tập phụ vậy.
Tuy nhiên, không cần thiết phải làm như vậy cho cực.
Đối với 1 vùng chọn hình chữ nhật đơn (nghĩa là không tô chọn nhiều vùng 1 lúc), VBA có thể dùng câu lệnh như sau để đối xử như cả sheet:
Selection.Cells(1, 1) tương đương với ô đầu tiên của vùng chọn. Viết đầy đủ là Sheet1.Selection.Cells(1, 1). Có thể dùng biến i, j bắt đầu từ 1 như cũ.
Đối với sheet thì là Sheet1.Cells(1, 1) nghĩa là ô A1, viết tắt là Cells(1, 1) vì mặc định selection đang là cả sheet.
Viehoai có thể thử sửa code cho vùng chọn bất kỳ. Dù không phải tô kiểu bida, nhưng kết quả cũng là tô carô. Coi như bài tập phụ vậy.
Tuy nhiên, không cần thiết phải làm như vậy cho cực.
Đối với 1 vùng chọn hình chữ nhật đơn (nghĩa là không tô chọn nhiều vùng 1 lúc), VBA có thể dùng câu lệnh như sau để đối xử như cả sheet:
Selection.Cells(1, 1) tương đương với ô đầu tiên của vùng chọn. Viết đầy đủ là Sheet1.Selection.Cells(1, 1). Có thể dùng biến i, j bắt đầu từ 1 như cũ.
Đối với sheet thì là Sheet1.Cells(1, 1) nghĩa là ô A1, viết tắt là Cells(1, 1) vì mặc định selection đang là cả sheet.
Cảm ơn anh rất nhiều em hiểu sâu hơn về vấn đề này. Tuy nhiên Anh Mỹ giải thích giúp em cách 1 sao có thêm Resize(1,1)?
Em xin sửa lại code theo cách quét vùng chọn bất kỳ ---> chạy code
(*) Sau lại nhốt chung vòng lặp sau vô trong vòng lặp trước vậy?
Nếu gặp ngay ngày CN từ đầu, có fải bạn fí fạm 6 lần lặp không cần thiết không nào?
Nên thoát khỏi nó ngay khi gặp ngày CN chứ; Tuy thêm 1 dòng lệnh, nhưng thưởng giảm đi được khoảng gần nữa đọan đường trong vòng lặp thứ nhật đó bạn.
Em sửa lại đoạn code theo góp ý của Bác ChanhTQ@ như sau:
Mã:
Sub Tinhngay()
Dim tongngay As Long, nghi As Integer, le As Integer
Dim i As Long, j As Date
Cells.ClearContents
tongngay = DateSerial(2010, 12, 31) - DateSerial(2010, 8, 19): le = 1
For i = 19 To 25
If Weekday(DateSerial(2010, 8, i)) = 1 Then Exit For
Next
For j = DateSerial(2010, 8, i) To DateSerial(2010, 12, 31) Step 7
With [COLOR=Red]ActiveCell[/COLOR]
.NumberFormat = "dd/mm/yyyy"
.Value = j
nghi = nghi + ActiveCell.Count
.Offset(1, 0).Select
End With
Next
If Weekday(DateSerial(2010, 9, 2)) <> 1 Then ActiveCell = DateSerial(2010, 9, 2)
MsgBox "Tong ngay lam viec la: " & tongngay - le - nghi
End Sub
Tuy nhiên chỗ ActiveCell muốn nó nằm ở cột A thì làm sao nhỉ? Không lẽ phải thêm 1 vòng lặp nữa?
Em sửa lại đoạn code theo góp ý của Bác ChanhTQ@ như sau:
Mã:
Sub Tinhngay()
Dim tongngay As Long, nghi As Integer, le As Integer
Dim i As Long, j As Date
Cells.ClearContents
tongngay = DateSerial(2010, 12, 31) - DateSerial(2010, 8, 19): le = 1
For i = 19 To 25
If Weekday(DateSerial(2010, 8, i)) = 1 Then Exit For
Next
For j = DateSerial(2010, 8, i) To DateSerial(2010, 12, 31) Step 7
With [COLOR=red]ActiveCell[/COLOR]
.NumberFormat = "dd/mm/yyyy"
.Value = j
nghi = nghi + ActiveCell.Count
.Offset(1, 0).Select
End With
Next
If Weekday(DateSerial(2010, 9, 2)) <> 1 Then ActiveCell = DateSerial(2010, 9, 2)
MsgBox "Tong ngay lam viec la: " & tongngay - le - nghi
End Sub
Tuy nhiên chỗ ActiveCell muốn nó nằm ở cột A thì làm sao nhỉ? Không lẽ phải thêm 1 vòng lặp nữa?
Một cách để cho kết quả từ A1:
_ Tạo một biến, thí dụ : Dim K as Integer
_ With ActiveCell thay bằng With [A1].Offset(K) hoặc With Cells(K + 1, 1) _ Thay.Offset(1, 0).Select bằng K= K + 1
Câu C bài số 4 trong trường hợp tổng quát, giả sử tô 1 vùng bất kỳ bởi 2 màu, khi đó ta sẽ thấy tập các ô có tính chất (Cột+Dòng) là 1 số chẵn sẽ được tô 1 màu, tập các ô có tính chất (Cột+Dòng) là 1 số lẻ được tô 1 màu. Như vậy nếu để tô mà không cần theo quy luật về đường đi thì các bạn chỉ cần duyệt và tô theo tính chất trên sẽ rất đơn giản. Còn về quy luật đường đi thì theo cách của bác ptm theo tôi là chuẩn nhất rồi. Vậy để giải quyết bài này theo hướng tổng quát nhất ta có thể đi theo mấy bước như sau:
1. Duyệt tất cả các ô, đẩy tất cả các ô cần tô(có cùng tính chất Dòng+Cột chẵn hoặc lẻ) vào 1 danh sách
2. Chọn ngẫu nhiên 1 ô trong danh sách, thực hiện tô màu cho ô này, sau khi tô thì loại ô đó ra khỏi danh sách, sau khi loại khỏi danh sách mà hết danh sách thì dừng.
3. Thực hiện di chuyển từ ô vừa tô theo nguyên tắc di chuyển(di chuyển đến ô nào thì kiểm tra nếu ô đó có trong danh sách thì loại ô đó ra khỏi danh sách), gặp dấu hiệu bị lặp thì dừng di chuyển và quay lại bước 2.
Tôi xin gửi các bạn code của cả 3 câu của bài 4 như sau:
Câu a
Mã:
Sub Row1()
Dim iValue As Long, iCol As Long, iRow As Long, iRows As Long, iCols As Long
iCols = InputBox("Nhap so cot:")
iRows = InputBox("Nhap so dong:")
For iValue = 1 To iRows * iCols
iRow = (iValue - 1) \ iCols + 1
iCol = (iValue - 1) Mod iCols + 1
Cells(iRow, iCol).Interior.ColorIndex = 4
Sleep 100
Next
End Sub
Câu b
Mã:
Sub Row2()
Dim iValue As Long, iCol As Long, iRow As Long, iRows As Long, iCols As Long
iCols = InputBox("Nhap so cot:")
iRows = InputBox("Nhap so dong:")
For iValue = 1 To iRows * iCols
iRow = (iValue - 1) \ iCols + 1
iCol = IIf(iRow Mod 2 = 1, (iValue - 1) Mod iCols + 1, iCols - ((iValue - 1) Mod iCols))
Cells(iRow, iCol).Interior.ColorIndex = 4
Sleep 100
Next
End Sub
Câu c
Mã:
Sub Caro1()
Dim iValue As Long, iCol As Long, iRow As Long, iRows As Long, iCols As Long, objDic As New
Dictionary, EpRow As Long, EpCol As Long
iCols = InputBox("Nhap so cot:")
iRows = InputBox("Nhap so dong:")
For iValue = 1 To iCols * iRows
iRow = (iValue - 1) \ iCols + 1
iCol = (iValue - 1) Mod iCols + 1
If ((iRow + iCol) Mod 2 = 0) Then objDic.Add iValue, iValue
Next
Randomize
Do While objDic.Count > 0
EpRow = IIf(Rnd() > 0.5, 1, -1)
EpCol = IIf(Rnd() > 0.5, 1, -1)
iValue = Int(Rnd() * objDic.Count)
iRow = (objDic.Keys(iValue) - 1) \ iCols + 1
iCol = (objDic.Keys(iValue) - 1) Mod iCols + 1
Cells(iRow, iCol).Interior.ColorIndex = 4
Sleep 200
objDic.Remove objDic.Keys(iValue)
Do While objDic.Count > 0
If iRow + EpRow < 1 Or iRow + EpRow > iRows Then EpRow = EpRow * (-1)
If iCol + EpCol < 1 Or iCol + EpCol > iCols Then EpCol = EpCol * (-1)
iRow = iRow + EpRow
iCol = iCol + EpCol
iValue = (iRow - 1) * iCols + iCol
Cells(iRow, iCol).Interior.ColorIndex = 4
Sleep 100
If objDic.Exists(iValue) Then
objDic.Remove iValue
Else
If iRow = 1 Or iRow = iRows Or iCol = 1 Or iCol = iCols Then Exit Do
End If
Loop
Loop
MsgBox "OK!"
End Sub
Các bạn thử cải tiến thành 3 câu như sau:
Câu a thành tô theo từng cột từ trên xuống dưới
Câu b thành tô theo từng cột từ trên xuống dưới rồi lại từ dưới lên trên
Câu c thành tô với 2 màu, khi nào tô hết màu thứ nhất thì tô tiếp màu thứ 2 để thành 1 bàn cờ với 2 màu.
Câu a và b chr cần thay đổi vị trí của cells(iRow,iCol) thành cells(iCol,iRow) là được.
Mã:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Câu a:
Mã:
Sub Row1()
Dim iValue As Long, iCol As Long, iRow As Long, iRows As Long, iCols As Long
Cells.Clear
iCols = InputBox("Nhap so cot:")
iRows = InputBox("Nhap so dong:")
For iValue = 1 To iRows * iCols
iRow = (iValue - 1) Mod iCols + 1
iCol = (iValue - 1) \ iCols + 1
Cells(iRow, iCol).Interior.ColorIndex = 4
Sleep 50
Next
End Sub
Câu b:
Mã:
Sub Row2()
Dim iValue As Long, iCol As Long, iRow As Long, iRows As Long, iCols As Long
Cells.Clear
iCols = InputBox("Nhap so cot:")
iRows = InputBox("Nhap so dong:")
For iValue = 1 To iRows * iCols
iCol = (iValue - 1) \ iCols + 1
iRow = IIf(iCol Mod 2 = 1, (iValue - 1) Mod iCols + 1, iCols - ((iValue - 1) Mod iCols))
Cells(iRow, iCol).Interior.ColorIndex = 4
Sleep 100
Next
End Sub
Đoạn code tô caro sao Em chạy nó bị báo lỗi ở khai báo objDic As New Dictionary nhỉ?
Câu c, nếu tô 1 màu, thì căn cứ vào diễn giải của RollOver, và đoạn code sau:
PHP:
For iValue = 1 To iCols * iRows
iRow = (iValue - 1) \ iCols + 1
iCol = (iValue - 1) Mod iCols + 1
If ((iRow + iCol) Mod 2 = 0) Then objDic.Add iValue, iValue
Next
Nếu thay điều kiện If (iRow + iCol) Mod 2 = 0 thành
If (iRow + iCol) Mod 2 = 1
sẽ tô các ô còn lại.
Vậy cho code chạy 2 lần với 2 tham số sẽ tô bàn cờ 2 màu:
Mã:
Private Sub CommandButton1_Click()
Cells.Clear
iCols = InputBox("Nhap so cot:")
iRows = InputBox("Nhap so dong:")
Caro1 iCols, iRows, 1, 15
Caro1 iCols, iRows, 0, 16
End Sub
Mã:
Sub Caro1(ByVal iCols As Long, ByVal iRows As Long, le As Long, clor As Long)
Dim iValue As Long, iCol As Long, iRow As Long
Dim objDic As New Dictionary, EpRow As Long, EpCol As Long
For iValue = 1 To iCols * iRows
iRow = (iValue - 1) \ iCols + 1
iCol = (iValue - 1) Mod iCols + 1
If ((iRow + iCol) Mod 2 = [COLOR="Red"][B]le[/B][/COLOR]) Then objDic.Add iValue, iValue
Next
Tiếp tục đi các Anh. Cho Em út có cơ hội học hỏi với. Các Bạn nào trên diễn đàn đang tham gia học hỏi topic này thì cố viết code đưa lên để các Anh giúp cho, đừng sợ sai gì cả đâu có ai mới học lại giỏi liền đâu? Riêng Em cái vụ VBA này rất khoái (mặc dù ít áp dụng cho công việc của mình).
Tiếp tục đi các Anh. Cho Em út có cơ hội học hỏi với. Các Bạn nào trên diễn đàn đang tham gia học hỏi topic này thì cố viết code đưa lên để các Anh giúp cho, đừng sợ sai gì cả đâu có ai mới học lại giỏi liền đâu? Riêng Em cái vụ VBA này rất khoái (mặc dù ít áp dụng cho công việc của mình).
Ngoài việc "chờ" người ta đưa bài tập mẫu, các bạn có thể tự mình nghĩ ra 1 tình huống gì đó phải dùng đến vòng lập rồi đưa lên đây để chúng ta cùng "mổ xẻ"
Nhớ lại ngày trước, khi mới chập chững vấn thân vào VBA, tay cơ còn quá non mà tôi còn dám "gan cùng mình", mở nguyên 1 topic ĐỐ VUI VỀ VBA đấy thôi
Ngán gì chứ? Hi... hi...
Tiếp tục đi các Anh. Cho Em út có cơ hội học hỏi với. Các Bạn nào trên diễn đàn đang tham gia học hỏi topic này thì cố viết code đưa lên để các Anh giúp cho, đừng sợ sai gì cả đâu có ai mới học lại giỏi liền đâu? Riêng Em cái vụ VBA này rất khoái (mặc dù ít áp dụng cho công việc của mình).
Gợi ý sơ qua!
Với câu 5a) của rollover79, các bạn dùng 2 vòng lập là dễ nhất:
PHP:
For iR = 1 To n
For iC = n - iR + 1 To n + iR - 1
Với
- n là số các bạn nhập vào InputBox
- iR và iC là vị trí cell
- Cells(iR, iC) chính là cell mà các bạn cần tô màu
Gợi ý gần như... toàn bộ rồi đấy!
-----------
Cũng có thể dùng 1 vòng lập For i = 1 to n^2 ---> Tùy ý
Thử xem! Câu 5b) gần như tương tự (về cách suy luận)
Em xin đáp án 2 câu trên bằng 2 vòng lặp For như anh NDU gợi ý như sau:
Mã:
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Câu a:
Mã:
Sub Tomau1()
Dim iR As Long, iC As Long, N As Long
Cells.Clear
N = InputBox("Hay nhap N?")
For iR = 1 To N
For iC = N - iR + 1 To N + iR - 1
With Cells(iR, iC)
.Interior.ColorIndex = 5
Sleep 50
End With
Next iC
Next iR
End Sub
Câu b:
Mã:
Sub Tomau2()
Dim iR As Long, iC As Long, N As Long
Cells.Clear
N = InputBox("Hay nhap N?")
For iR = 1 To N
For iC = N - iR + 1 To N + iR
With Cells(iR, iC)
.Interior.ColorIndex = 5
Sleep 50
End With
Next iC
Next iR
End Sub
Dùng 1 vòng lặp thì Em chưa nghiên cứu tới. Cố gắng chiều nay có thể hoàn thành 1 vòng lặp. Hì hì
MinhCong khá lắm, nhất là đã tự mình suy luận được câu 5b) ---> Cố gắng lên, chẳng bao lâu bạn sẽ thành cao thủ như ai!
Sư phụ ptm0412 đã từng cho tôi 1 bài học: Cái khó nằm ở tư duy logic chứ còn code kiết gì đó chỉ là công cụ hổ trợ, làm vài lần tự nhiên quen tay thôi
Về vụ 1 vòng lập, nghiên cứu thì cứ việc nhưng xin lưu ý với bạn rằng với bài này, dù là 1 vòng lập hay 2 vòng lập thì tốc độ vẫn như nhau (có chăng là nghiên cứu thuật toán chơi, biết đâu dùng trong dịp khác)
MinhCong khá lắm, nhất là đã tự mình suy luận được câu 5b) ---> Cố gắng lên, chẳng bao lâu bạn sẽ thành cao thủ như ai!
Sư phụ ptm0412 đã từng cho tôi 1 bài học: Cái khó nằm ở tư duy logic chứ còn code kiết gì đó chỉ là công cụ hổ trợ, làm vài lần tự nhiên quen tay thôi
Về vụ 1 vòng lập, nghiên cứu thì cứ việc nhưng xin lưu ý với bạn rằng với bài này, dù là 1 vòng lập hay 2 vòng lập thì tốc độ vẫn như nhau (có chăng là nghiên cứu thuật toán chơi, biết đâu dùng trong dịp khác)
1 vòng lặp Em làm có lẽ được 1/2 vì Em nghĩ đặt được điều kiện cho iRow rồi, còn cái ICol thì đang nghiên cứu, thấy khó tư duy quá. Biết cách nó chạy nhưng cái thuật toán thì chưa tìm ra được mới tức chứ.
1 vòng lặp Em làm có lẽ được 1/2 vì Em nghĩ đặt được điều kiện cho iRow rồi, còn cái ICol thì đang nghiên cứu, thấy khó tư duy quá. Biết cách nó chạy nhưng cái thuật toán thì chưa tìm ra được mới tức chứ.
Hình như iRow bằng vầy thì phải iRow = Int(Sqr(i - 1)) + 1
Kiểm tra lại xem ---> Khỏi IF
Khó ở chổ tìm iCol đấy ---> Bùn lắm thì IF... IF gì đó đi!
Ẹc... Ẹc...
1 vòng lặp Em làm có lẽ được 1/2 vì Em nghĩ đặt được điều kiện cho iRow rồi, còn cái ICol thì đang nghiên cứu, thấy khó tư duy quá. Biết cách nó chạy nhưng cái thuật toán thì chưa tìm ra được mới tức chứ.
iRow thì như bác cách của bác ndu. iCol thì tôi gợi ý chút thế này.
Với mỗi 1 giá trị i ta đã biết iRow, với mỗi iRow ta đã biết cột xuất phát của dòng rồi, lấy cột xuất phát + thứ tự của ô tương ứng với giá trị i trong dòng đó là xong. Để tính thứ tự của ô tương ứng với giá trị i thì hãy thử vận dụng các dữ kiện bao gồm i và tổng số ô của các dòng phía trên xem sao.
Ví dụ:
Với N=4, khi i=8 ta có iRow=3, Cột xuất phát là cột 2(N-iRow+1), giờ ta tính tổng các ô của các dòng phía trên(dòng 1 và dòng 2), ở đây là 4=(iRow-1)^2. Giờ từ i=8, cột xuất phát là 2, và tổng các ô các dòng phía trên là 4, hãy tính thử xem sao.
iRow thì như bác cách của bác ndu. iCol thì tôi gợi ý chút thế này.
Với mỗi 1 giá trị i ta đã biết iRow, với mỗi iRow ta đã biết cột xuất phát của dòng rồi, lấy cột xuất phát + thứ tự của ô tương ứng với giá trị i trong dòng đó là xong. Để tính thứ tự của ô tương ứng với giá trị i thì hãy thử vận dụng các dữ kiện bao gồm i và tổng số ô của các dòng phía trên xem sao.
Ví dụ:
Với N=4, khi i=8 ta có iRow=3, Cột xuất phát là cột 2(N-iRow+1), giờ ta tính tổng các ô của các dòng phía trên(dòng 1 và dòng 2), ở đây là 4=(iRow-1)^2. Giờ từ i=8, cột xuất phát là 2, và tổng các ô các dòng phía trên là 4, hãy tính thử xem sao.
Mọi người tính cột xuất phát thế nào ấy nhỉ? Tôi tính chỉ bằng 1/2 của Roll và Huuthang thôi: N - iRow + 1
Còn jCol, theo tôi cứ tính jCol xuất phát, sau đó cho jCol tăng 1 dần dần. Khi nào xuống dòng (iRow tăng), tính lại jCol xuất phát mới. Cách tư duy này đơn giản hơn.
Kể cả iRow, nếu tư duy đơn giản thì cho iRow xuất phát = 1, khi thoả điều kiện, iRow = iRow +1
Kết hợp cả 2, iRow tăng, tính lại jCol, cùng 1 điều kiện, chỉ cần 1 If.
Mọi người tính cột xuất phát thế nào ấy nhỉ? Tôi tính chỉ bằng 1/2 của Roll và Huuthang thôi: N - iRow + 1
Còn jCol, theo tôi cứ tính jCol xuất phát, sau đó cho jCol tăng 1 dần dần. Khi nào xuống dòng (iRow tăng), tính lại jCol xuất phát mới. Cách tư duy này đơn giản hơn.
Kể cả iRow, nếu tư duy đơn giản thì cho iRow xuất phát = 1, khi thoả điều kiện, iRow = iRow +1
Kết hợp cả 2, iRow tăng, tính lại jCol, cùng 1 điều kiện, chỉ cần 1 If.
Cột xuất phát là cột xuất phát của 1 dòng cụ thể nào đó mà, ví dụ tại dòng iRow thì cột xuất phát sẽ là N-iRow+1, còn việc tính iCol thì đúng là hơi khó tư duy, nhưng làm theo cách đó thì thuật toán đọc lên rõ ràng. Cứ với mỗi giá trị ta có Dòng và Cột rồi đem xử lý là xong. Còn phương pháp tăng Dòng và Cột thì có vẻ nó giống với 2 vòng lặp, còn khi thể hiện với 1 vòng lặp thì thuật toán hơi rối.
Xin lỗi RollOver đã đọc nhầm chỗ này: 2(N-iRow+1), nếu viết cách ra và ghi chú 2 (tính bằng N-iRow+1) thì rõ nghĩa hơn. Xin lỗi HuuThang vì HT cũng giải thích chứ không phải tính.
Còn ý tôi khi cho tăng dòng cột là cho người mới học, nếu cách tính toán khó khăn thì nghĩ đến cách tư duy đơn giản trước. Vả lại, nếu ta phát triển tô như trên nhưng 2 lần, 1 lần là lần lượt tăng mổi dòng 1, 3, 5, .., N ô, sau đó giảm mỗi dòng N-2, ..., 5, 3 ,1 ô (dạng hình thoi bằng 2 hình tam giác bài 5, 1 úp 1 lật ngửa); cũng dễ phát triển hơn. Đơn giản vốn dễ phát triển hơn phức tạp mà.
Với j là biến chạy, n là số nhập trong InputBox
Thí nghiệm thử rồi làm luôn câu 5b) cho trường hợp 1 vòng lập
-------------------------------
Nếu đã hoàn tất, các bạn hãy thử nghĩ đến vấn đề bẫy lỗi xem:
- Với n như thế nào thì code sẽ lỗi?
- Giải pháp bẫy lỗi ra sao?
------------------------------- (Lập trình viên thường ít khi sợ viết code mà chỉ ngán việc bẫy lỗi thôi!)
Với j là biến chạy, n là số nhập trong InputBox
Thí nghiệm thử rồi làm luôn câu 5b) cho trường hợp 1 vòng lập
-------------------------------
Nếu đã hoàn tất, các bạn hãy thử nghĩ đến vấn đề bẫy lỗi xem:
- Với n như thế nào thì code sẽ lỗi?
- Giải pháp bẫy lỗi ra sao?
------------------------------- (Lập trình viên thường ít khi sợ viết code mà chỉ ngán việc bẫy lỗi thôi!)
Em xin đưa câu 5a lên theo hướng dẫn của anh NDU như sau:
Mã:
[COLOR=Blue]Sub Tomau3()
Dim iR As Long, iC As Long, N As Long
Cells.Clear
N = InputBox("Hay nhap N?")
If N > 128 Or N < 0 Then Exit Sub
For i = 1 To N ^ 2
iR = Int(Sqr(i - 1)) + 1
iC = N - iR + i - (iR - 1) ^ 2
With Cells(iR, iC)
.Interior.ColorIndex = 5
Sleep 50
End With
Next
End Sub[/COLOR]
Lỗi khi nhập n theo Em nghĩ như sau:
Lỗi nếu n để trống (tức không nhập số vào box), n<0 và n>128 (vì excel có tổng cộng là 256 cột => 256/2=128, mà ta tô màu đối xứng từ giữa ra 2 bên).
Bẫy lỗi như vậy không biết có đúng không? Các Anh xem và góp ý cho Em nhé!
Em xin đưa câu 5a lên theo hướng dẫn của anh NDU như sau:
Mã:
[COLOR=Blue]Sub Tomau3()
Dim iR As Long, iC As Long, N As Long
Cells.Clear
N = InputBox("Hay nhap N?")
If N > 128 Or N < 0 Then Exit Sub
For i = 1 To N ^ 2
iR = Int(Sqr(i - 1)) + 1
iC = N - iR + i - (iR - 1) ^ 2
With Cells(iR, iC)
.Interior.ColorIndex = 5
Sleep 50
End With
Next
End Sub[/COLOR]
Lỗi khi nhập n theo Em nghĩ như sau:
Lỗi nếu n để trống (tức không nhập số vào box), n<0 và n>128 (vì excel có tổng cộng là 256 cột => 256/2=128, mà ta tô màu đối xứng từ giữa ra 2 bên).
Bẫy lỗi như vậy không biết có đúng không? Các Anh xem và góp ý cho Em nhé!
Gần được rồi đấy!
Thiếu 1 vài chổ:
- Biến i chưa khai báo
- Chưa bẫy lỗi nhập TEXT vào InputBox ---> Có thể cải tiến thành Application.InputBox("Hay nhap N?", Type:=1)
- Mặc dù nhập số thập phân vào nó vẫn chạy (vì khai báo n as Long) nhưng cũng nên để ý đến việc bẫy lỗi này
- Khó nhất là bẫy lỗi không nhập gì hoặc bấm Cancel trên InputBox
Gần được rồi đấy!
- Mặc dù nhập số thập phân vào nó vẫn chạy (vì khai báo n as Long) nhưng cũng nên để ý đến việc bẫy lỗi này
- Khó nhất là bẫy lỗi không nhập gì hoặc bấm Cancel trên InputBox
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Tomau3()
Dim iR As Long, iC As Long, [COLOR=Red][B]N[/B][/COLOR], i As Long
Cells.Clear
[COLOR=Black]N = [B][COLOR=Red]Val([/COLOR][/B]InputBox("Hay nhap N?"))[/COLOR]
If N > 128 Or N < 0 Or [COLOR=Red]N <> Int(N)[/COLOR] Then Exit Sub
For i = 1 To N ^ 2
iR = Int(Sqr(i - 1)) + 1
iC = N - iR + i - (iR - 1) ^ 2
Cells(iR, iC).Interior.ColorIndex = 5
Sleep 50
Next
End Sub
Quan trọng nằm ở chổ màu đỏ ấy
- Khai báo N kiểu Variant
- N = Val(...) suy ra nếu InputBox là TEXT thì N = 0
- Chấp luôn bấm Cancel và OK khi chưa nhập gì
). 
