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

.
.
.

 

[SA_DQ]

Bài đọc thêm: Lọc danh sách các em nữ, sinh theo các quí khác nhau.

Trên nền CSDL của bài #46, chúng ta tự đề ra nhiệm vụ cho mình là lọc ra danh sách các em nữ sinh của trường có ngày tháng sinh vào quí nào đó (như quí II) chảng hạn.

Vì đây là danh sách học sinh fổ thông, nên tuổi của các em không chênh nhau là bao nhiêu.
Bỡi vậy mình đề xuất cách lọc như trong file; Trong thực tiển cuộc sống chuyện này khó áp dụng rọng rãi trong các cơ quan, xí nghiệp. Vì ở đó độ rọng tuổi là quá lớn.
Trong trường hợp là CQ/xí nghiệp, chúng ta fải tìm cách làm khác

Sau khi đọc xong bài, rất mong các bạn thử sức mình với 1 trong các nhiệm vụ sau:

(*) Lọc thử danh sách HS nam theo các quí.

(*) Lọc & xếp theo tuần tự tăng dần theo ngày tháng sinh của các em trong quí;

(*) Lọc danh sách sinh nhật theo quí của các nhân viên toàn cơ quan/xí nghiệp (Độ tuổi lao động)

 

[SA_DQ]

Bài tập TVT (Tìm vị trí trong chuỗi)

(A) Giả dụ tôi có 1 chuỗi gốc là "GIAIPHAPEXCEL.COM"

Nhiệm vụ đề ra là tìm & liệt kê vị trí lần lượt các kí tự trong cụm "GPE.COM" có trong chuỗi góc trên
(Đáp án: 1_5_9_14_11_16_17)

(B) Giả dụ chuỗi gốc của tôi bây giờ là "ABAEBAC"
Cũng nhiệm vụ trên, tôi cần có đáp án là: "1_2_3_6_7" khi tìm vị trí của "ABAAC"
(Có nghĩa là con số 6 trong đáp án chỉ ra vị trí thứ 3 của "A" trong chuỗi gốc.)

Chúc các bạn thành công zới vòng lặp For. . .Next thôi nha!

 

[phihndhsp]

(A) Giả dụ tôi có 1 chuỗi gốc là "GIAIPHAPEXCEL.COM"

Nhiệm vụ đề ra là tìm & liệt kê vị trí lần lượt các kí tự trong cụm "GPE.COM" có trong chuỗi góc trên
(Đáp án: 1_5_9_14_11_16_17)

(B) Giả dụ chuỗi gốc của tôi bây giờ là "ABAEBAC"
Cũng nhiệm vụ trên, tôi cần có đáp án là: "1_2_3_6_7" khi tìm vị trí của "ABAAC"
(Có nghĩa là con số 6 trong đáp án chỉ ra vị trí thứ 3 của "A" trong chuỗi gốc.)

Chúc các bạn thành công zới vòng lặp For. . .Next thôi nha!

bài tập này cho người mới bắt đầu cũng hơi căng đó, nếu xét từng ký tự phải 2 vòng lặp, rồi sau đó sắp xếp các số thứ tự lại nữa?

 

[concogia]

bài tập này cho người mới bắt đầu cũng hơi căng đó, nếu xét từng ký tự phải 2 vòng lặp, rồi sau đó sắp xếp các số thứ tự lại nữa?

Một vòng lặp và......... ra luôn kết quả (A)

 

[SA_DQ]

. . . cũng hơi căng đó, nếu xét từng ký tự phải 2 vòng lặp, rồi sau đó sắp xếp các số thứ tự lại nữa?

Có thể xài chỉ 1 vòng lặp thôi, thêm 1 mẹo nhỏ là . . .

 

[ndu96081631]

bài tập này cho người mới bắt đầu cũng hơi căng đó, nếu xét từng ký tự phải 2 vòng lặp, rồi sau đó sắp xếp các số thứ tự lại nữa?

Tôi tưởng chỉ 1 vòng lập là được chứ!
???!!!
Ẹc... Ẹc...
(hàm InStr(Start.... chú ý chỗ Start là được rồi)

 

[chuot0106]

Các cao thủ cứ tranh luận ko khéo lại đưa đáp án luôn bây giờ đó. Các thầy cứ bình tĩnh để các thành viên mới học tham gia ạ!

 

[phihndhsp]

Các cao thủ cứ tranh luận ko khéo lại đưa đáp án luôn bây giờ đó. Các thầy cứ bình tĩnh để các thành viên mới học tham gia ạ!

xin lỗi là không để ý tới hàm InStr
nếu các thành viên mới giải được rồi? thì có thể viết 1 function để giải quyết bài trên không cần hàm InStr

 

[chuot0106]

GPE chắc bây giờ toàn thành viên "cạo gội" rồi hay sao mà không thấy thành viên mới học VBA nào tham gia topic này qua!
Người ra để chắc cũng chán!

 

[ptm0412]

GPE chắc bây giờ toàn thành viên "cạo gội" rồi hay sao mà không thấy thành viên mới học VBA nào tham gia topic này qua!
Người ra để chắc cũng chán!

Bạn cũng gạo cội? Tôi không thấy bạn tham gia giải đề?

 

[chuot0106]

Bạn cũng gạo cội? Tôi không thấy bạn tham gia giải đề?

Ý tôi muốn nói các thành viên mới học VBA chứ còn với cá nhân tôi thì bài này tôi làm xong lâu rồi. Tôi muốn để các thành viên mới nghiên cứu VBA giải nên không đưa đáp án nên thôi. Thầy nói vậy em mạo muội gửi đáp án ạ!

Option Explicit
Public Sub timvitri()
Dim d As Long, i As Long, tmp As String, vt As Long
Dim Strm As String, Strc As String
    Strm = Sheet1.Range("A12")
    Strc = Sheet1.Range("B12")
For i = 1 To Len(Strc)
    vt = InStr(i, Strm, Mid(Strc, i, 1))
    tmp = tmp & vt & " - "
Next i
    MsgBox Left(tmp, Len(tmp) - 2)
End Sub

 

[dhn46]

(A) Giả dụ tôi có 1 chuỗi gốc là "GIAIPHAPEXCEL.COM"

Nhiệm vụ đề ra là tìm & liệt kê vị trí lần lượt các kí tự trong cụm "GPE.COM" có trong chuỗi góc trên
(Đáp án: 1_5_9_14_11_16_17)

(B) Giả dụ chuỗi gốc của tôi bây giờ là "ABAEBAC"
Cũng nhiệm vụ trên, tôi cần có đáp án là: "1_2_3_6_7" khi tìm vị trí của "ABAAC"
(Có nghĩa là con số 6 trong đáp án chỉ ra vị trí thứ 3 của "A" trong chuỗi gốc.)

Chúc các bạn thành công zới vòng lặp For. . .Next thôi nha!

Trong khi chờ các bạn khác làm với Instr hay phương án khác, dhn46 cũng tham gia tí cho thêm phần không khí. Ngày mới chập chững VBA qua những bài tập của bác Sa DHN46 đã học hỏi được rất nhiều.

Sub Gpe()
    Dim SourceStr As String
    Dim SearchStr As String
    Dim i As Long


    SourceStr = "GIAIPHAPEXCEL.COM"
    SearchStr = "GPE.COM"


    For i = 1 To Len(SourceStr)
        SearchStr = Replace(SearchStr, Mid(SourceStr, i, 1), i & "_")
    Next


    MsgBox Left(SearchStr, Len(SearchStr) - 1)
    
End Sub

 

[ChanhTQ@]

(1)

Trong khi chờ các bạn khác làm với Instr hay phương án khác, dhn46 cũng tham gia tí cho thêm phần không khí. Ngày mới chập chững VBA qua những bài tập DHN46 đã học hỏi được rất nhiều.

Macro này mới đúng cho trường hợp (A) thôi đó nha các bạn; Các bạn khác hãy tiếp tục đi nào!

(2)

Hàm InStr(Start, ..., ...) (chú ý chỗ Start là được rồi)

Có thể có 1 số bạn trẻ sẽ lúng túng với tham biến "Start" này.
Có thể có cách khác xíu để tránh xài tham biến này đó các bạn, Đó là hàm Replace() trong VBA mà DHN46 đã đưa ra; Các bạn thử tham khảo xem sao.

(3) Chàng chuột 0106 thân mến!
Trong trường hợp đặc biệt này, khi mà
Chuỗi góc là "CCABAEBAC"
& chuỗi đem tra là "CACBAA"
Thì bạn sẽ sai đáp án kia đấy.

 

[chuot0106]

(1)

Macro này mới đúng cho trường hợp (A) thôi đó nha các bạn; Các bạn khác hãy tiếp tục đi nào!

(2)



Có thể có 1 số bạn trẻ sẽ lúng túng với tham biến "Start" này.
Có thể có cách khác xíu để tránh xài tham biến này đó các bạn, Đó là hàm Replace() trong VBA mà DHN46 đã đưa ra; Các bạn thử tham khảo xem sao.

Code ở bài trên của em test thấy đúng cho cả 2 TH thầy ạ!

 

[chuot0106]

..................................................
(3) Chàng chuột 0106 thân mến!
Trong trường hợp đặc biệt này, khi mà
Chuỗi góc là "CCABAEBAC"
& chuỗi đem tra là "CACBAA"
Thì bạn sẽ sai đáp án kia đấy.

Mong thầy đưa đáp án để em còn kiểm tra kết quả khi viết code xong.

 

[Hau151978]

Em xin tham gia câu 2, điều kiện chuỗi tìm kiếm không có "$"

Function TimViTri$(ByVal ChuoiGoc$, ByVal ChuoiTim$)
    Dim i&, s$
    For i = 1 To Len(ChuoiTim)
        s = Mid(ChuoiTim, i, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, s) & "_"
        ChuoiGoc = Replace(ChuoiGoc, s, "$", 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
End Function
Sub test()
    MsgBox TimViTri("ABAEBAC", "ABAAC")
End Sub

 

[SA_DQ]

Mong được đưa đáp án để em còn kiểm tra kết quả khi viết code xong.
Chuỗi góc là "CCABAEBAC"
& chuỗi đem tra là "CACBAA"

Đáp án sẽ là 1_3_2_4_5_8 mới là đúng trong trường hợp này

Tuy nhiên trong macro của bạn, khi xét đến kí tự "C" thứ 2 trong chuỗi tìm, bạn đã cắt cụt fần 2 kí tự đầu của chuỗi nguồn/gốc đi rối; May thay còn anh 'C' cuối nên nó lấy ra & báo cáo láo như những BC lâu nay của các cấp, các ngành của nước ta!

 

[chuot0106]

Đáp án sẽ là 1_3_2_4_5_8 mới là đúng trong trường hợp này

Tuy nhiên trong macro của bạn, khi xét đến kí tự "C" thứ 2 trong chuỗi tìm, bạn đã cắt cụt fần 2 kí tự đầu của chuỗi nguồn/gốc đi rối; May thay còn anh 'C' cuối nên nó lấy ra & báo cáo láo như những BC lâu nay của các cấp, các ngành của nước ta!

Nếu vẫn làm theo theo cách của em thì chỗ start phải xử lí như thế nào ạ? Mong thầy chỉ giúp ạ.(Không dùng hàm Replace)

 

[ndu96081631]

Nếu vẫn làm theo theo cách của em thì chỗ start phải xử lí như thế nào ạ? Mong thầy chỉ giúp ạ.(Không dùng hàm Replace)

Cố suy nghĩ chút là ra chứ gì! Ở đây là BÀI TẬP VBA ĐƠN GIẢN, nếu không "cố" được thì còn chỗ nào để mà "cố" nữa đây?

 

[chuot0106]

Cố suy nghĩ chút là ra chứ gì! Ở đây là BÀI TẬP VBA ĐƠN GIẢN, nếu không "cố" được thì còn chỗ nào để mà "cố" nữa đây?

Ok thầy, tại đầu em đang mụ quá!

 

[Hau151978]

Các thầy ra đề khó quá, 1 vòng lặp, không dùng Replace, dĩ nhiên không dùng Dictionary.

Function TimViTri2$(ByVal ChuoiGoc$, ByVal ChuoiTim$)
    Dim i&, s$, tmp$, k&, arr(1 To 1000) As Long
    For i = 1 To Len(ChuoiTim)
        s = Mid(ChuoiTim, i, 1)
        tmp = Left(ChuoiTim, i - 1)
        k = InStrRev(tmp, s)
        If k > 0 Then k = arr(k)
        arr(i) = InStr(k + 1, ChuoiGoc, s)
        TimViTri2 = TimViTri2 & arr(i) & "_"
    Next
    If Len(TimViTri2) > 0 Then TimViTri2 = Left(TimViTri2, Len(TimViTri2) - 1)
End Function
Sub test()
    MsgBox TimViTri2("CCABAEBAC", "CACBAA")
End Sub

 

[SA_DQ]

Bổ sung 1 vòng lặp để loại bỏ điều kiện ("$")

Em xin tham gia câu 2, điều kiện chuỗi tìm kiếm không có "$"
(Bài 116)

Option Explicit
Dim TuTT As String, ChuoiGoc$
Sub test()
 Const KhongGiongAi As String = "_|!@#$%^&()-=+*"   '<=|'
 Dim J As Long
 
 ChuoiGoc$ = "ABAEBAC"
 For J = 1 To Len(KhongGiongAi)
    TuTT = Mid(KhongGiongAi, J, 1)
    If Not InStr(ChuoiGoc, TuTT) Then
        Exit For
    End If
 Next J
 MsgBox TimViTri(ChuoiGoc$, "ABAAC"), , ChuoiGoc$
End Sub

[B]Function TimViTri$(ByRef ChuoiGoc$, ByVal ChuoiTim$)[/B]   
 Dim I&, S$
    For I = 1 To Len(ChuoiTim)
        S = Mid(ChuoiTim, I, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, S) & "_"
        ChuoiGoc = Replace(ChuoiGoc, S, TuTT, 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
[B]End Function[/B]

 

[chuot0106]

Option Explicit
Dim TuTT As String, ChuoiGoc$
Sub test()
 Const KhongGiongAi As String = "_|!@#$%^&()-=+*"   '<=|'
 Dim J As Long
 
 ChuoiGoc$ = "ABAEBAC"
 For J = 1 To Len(KhongGiongAi)
    TuTT = Mid(KhongGiongAi, J, 1)
    If Not InStr(ChuoiGoc, TuTT) Then
        Exit For
    End If
 Next J
 MsgBox TimViTri(ChuoiGoc$, "ABAAC"), , ChuoiGoc$
End Sub

[B]Function TimViTri$(ByRef ChuoiGoc$, ByVal ChuoiTim$)[/B]   
 Dim I&, S$
    For I = 1 To Len(ChuoiTim)
        S = Mid(ChuoiTim, I, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, S) & "_"
        ChuoiGoc = Replace(ChuoiGoc, S, TuTT, 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
[B]End Function[/B]

Những cái này với người mới bắt đầu e rằng hơi quá sức thầy ạ. Đó là lí do tại sao ko có thành viên mới học vba nào dám tham gia.
Em nghĩ với đề bài này thì cứ cho thành viên mới dùng 2 vòng for đi, hay nhiều hơn miễn sao họ ra kết quả.

 

[phihndhsp]

Option Explicit
Dim TuTT As String, ChuoiGoc$
Sub test()
 Const KhongGiongAi As String = "_|!@#$%^&()-=+*"   '<=|'
 Dim J As Long
 
 ChuoiGoc$ = "ABAEBAC"
 For J = 1 To Len(KhongGiongAi)
    TuTT = Mid(KhongGiongAi, J, 1)
    If Not InStr(ChuoiGoc, TuTT) Then
        Exit For
    End If
 Next J
 MsgBox TimViTri(ChuoiGoc$, "ABAAC"), , ChuoiGoc$
End Sub

[B]Function TimViTri$(ByRef ChuoiGoc$, ByVal ChuoiTim$)[/B]   
 Dim I&, S$
    For I = 1 To Len(ChuoiTim)
        S = Mid(ChuoiTim, I, 1)
        TimViTri = TimViTri & InStr(ChuoiGoc, S) & "_"
        ChuoiGoc = Replace(ChuoiGoc, S, TuTT, 1, 1)
    Next
    If Len(TimViTri) > 0 Then TimViTri = Left(TimViTri, Len(TimViTri) - 1)
[B]End Function[/B]

nếu đã viết function thì tham số chỉ nên là 1 chuỗi và 1 ký tự để so sánh

 

[VetMini]

Nếu tôi dạy môn học VBA. Và nếu tôi ra cái đề này cho học sinh của tôi tập, thì cách chấm điểm của tôi khác quý vị nhiều.

Với đề bài trên, học sinh nào giải ra thì tối đa chỉ được 75% điểm (7,5 điểm / 10)

Những học sinh nào đặt câu hỏi "có phải chuỗi thứ 2 là chuỗi thứ nhất đã cắt bớt vài ký tự bất kỳ? và nếu không phải thì những ký tự không tìm được thì xử lý ra sao?" sẽ được 2,5 điểm còn lại.

 

[SA_DQ]

Gởi chàng Chuột 0106:
Rất tán thành í kiến của bạn & xin cảm ơn;

Đề xuất 1 vòng lặp là do thầy Phi đưa ra 2 vòng lặp đó thôi; Lúc đó mọi người mới nêu rằng 1 vòng lặp cũng được;
Còn bài trên đưa ra vòng lặp để bỏ điều kiện "$" (tạm gọi là thế), nhưng cũng là gợi í nào đó để việc thay thế đảm bảo chắc chắn hơn mà thôi;
Theo mình thì bài này còn nhiều cách làm khác "Hàn lâm" hơn nhiều; Chúng ta cùng đợi những tham khảo từ các nhà siêu lập trình đưa ra tác fẩm kinh điển của mình.

Chúc ngày cuối tuần vui vẻ!

Những học sinh nào đặt câu hỏi "có phải chuỗi thứ 2 là chuỗi thứ nhất đã cắt bớt vài ký tự bất kỳ? và nếu không phải thì những ký tự không tìm được thì xử lý ra sao?" sẽ được 2,5 điểm còn lại.

Đúng vậy & chữ cái ta không tìm thấy đó sẽ nên điền số 0; Nhưng chưa "Học viên" nào hỏi mà!

nếu đã viết function thì tham số chỉ nên là 1 chuỗi và 1 ký tự để so sánh

Cái này là của người khác, mình chỉ thêm mắm, tiêu & ớt xíu thôi!

 

[VetMini]

...
Theo mình thì bài này còn nhiều cách làm khác "Hàn lâm" hơn nhiều; Chúng ta cùng đợi những tham khảo từ các nhà siêu lập trình đưa ra tác fẩm kinh điển của mình.

Chúc ngày cuối tuần vui vẻ!

Theo tôi thì nếu không xác định vấn đề ở vài #125 thỉ tất cả mọi lời giải đều là giải mò.

 

[Hau151978]

Nếu tôi dạy môn học VBA. Và nếu tôi ra cái đề này cho học sinh của tôi tập, thì cách chấm điểm của tôi khác quý vị nhiều.

Với đề bài trên, học sinh nào giải ra thì tối đa chỉ được 75% điểm (7,5 điểm / 10)

Những học sinh nào đặt câu hỏi "có phải chuỗi thứ 2 là chuỗi thứ nhất đã cắt bớt vài ký tự bất kỳ? và nếu không phải thì những ký tự không tìm được thì xử lý ra sao?" sẽ được 2,5 điểm còn lại.

Những chữ không có thì điền số 0, các bài 116 và 121 em đều làm như vậy.

 

[Hau151978]

nếu đã viết function thì tham số chỉ nên là 1 chuỗi và 1 ký tự để so sánh

Nếu tham số là 1 chuỗi và 1 ký tự thì đó chính là hàm INSTR, cần gì phải dùng hàm riêng nữa?

 

[VetMini]

@Hau151978:
Hàm Replace không hữu hiệu bằng hàm Mid. Hàm mid trả về chính vị trí chuỗi, nó có thể nằm bên trái phép gán. Và đó là thủ thuật hiệu quả nhất để sửa một đoạn bên trong chuỗi.

@SA_DQ:
Theo nguyên tắc lập trình thì mọi vòng lặp đều có thể thay thế bằng đệ quy.
Nếu bạn đã dùng đệ quy để giảm 1 vòng lặp thì chả có lý do gì để không giảm luôn vòng lặp còn lại.

@các bạn mới tập:
Đây là bài tập tốt để thử nghiệm tầm hiểu biết của các bạn về vòng lặp và một vài hàm chuỗi, nếu bạn biết cả array thì dùng array để chứa kết quả và join một lần cuối thay vì dùng phép nối từng phần.
Tuy nhiên, bạn phải đặt ra 2 cấu hỏi như tôi đã đề cập trên:
Nếu chuỗi 2 là chuõi 1 đã cắt bớt thì có thể có cách khác để làm
Nếu chuỗi 2 không phải là chuỗi 1 cắt bớt thì phải có quy luật hiển thì các ký tự không tìm được.

 

[SA_DQ]

Bài tập "Giải mã ngày"

Mình có một hàm người dùng để mã hóa 1 ngày cụ thể nào đó thành chuỗi 3 kí tự;
Hàm đó có nội dung như sau:

Option Explicit
Function MaNgay(Optional Dat As Date)
 Const GPE$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
 If Dat = 0 Then Dat = Date
 MaNgay = Mid$(GPE, Year(Dat) - 2000, 1) & Mid$(GPE, 1 + Month(Dat), 1)
 MaNgay = MaNgay & Mid$(GPE, 1 + Day(Dat), 1)
End Function

Cách sử dụng hàm này là: Nếu ta cung cấp cho hàm 1 tham biến 1 số liệu biểu thị 1 ngày nào đó, thì hàm sẽ trả về cho ta chuỗi gồm 3 kí tự biểu thị cho ngày duy nhất đó
Ví dụ:
Nếu ta cung cấp tham biến 1/13/2015; hàm sẽ trả về chuỗi "E1D"
Nếu ta không cung cấp tham biến, hàm sẽ lấy ngày hiện hành thay thế, như
hôm nay hàm sẽ trả về chuỗi "E5L"


Nhiệm vụ của bài tập đề ra là:

Xin các bạn viết cho 1 hàm tự tạo, mà khi ta cung cấp chuỗi ngày được mã hóa bỡi hàm trên, thì hàm sẽ trả về ngày/tháng/năm mà hàm trên đã hóa giải.

Ví dụ cụ thể =NgayMa( "E1D") sẽ trả về ngày 1/13/2015


Chúc các bạn nhiều thành công!

 

[doveandrose]

đi xuôi xài mid thì đi ngược xài inStr
xuôi + 1 thì đi ngược -1
đầu xuôi không bẫy lỗi thì đầu ngược càng không cần
ví dụ ngày 1/1/2000 được chuyển thành 011 và đưa vào cell tự động đổi thành 11 vậy đi ngược dịch làm sao ra 1/1/2000

Public Function DateFrom3Char(ByVal chars As String) As Date
Const GPE = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
DateFrom3Char = DateSerial(InStr(GPE, Mid(chars, 1, 1)) + 2000, InStr(GPE, Mid(chars, 2, 1)) - 1, _
InStr(GPE, Mid(chars, 3, 1)) - 1)


End Function

 

[SA_DQ]

Vậy trong trường hợp này thì cần sửa lại hàm =MaNgay(Optional Dat As Date)

để hàm dịch ngược khỏi sai là như thế nào đây các bạn;

Các bạn khắc fục dùm lỗi mà Doveandrose đã nêu:
[thongbao]đầu xuôi không bẫy lỗi thì đầu ngược (??) cần
ví dụ ngày 1/1/2000 được chuyển thành 011 và đưa vào cell tự động đổi thành 11 vậy đi ngược dịch làm sao ra 1/1/2000
[/thongbao]

Xin cảm ơn trước nha!

 

[SA_DQ]

Bài tập Xếp lại trật tự cho 1 chuỗi

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

 

[chuot0106]

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

Không biết chuỗi ban đầu có dấu tiếng việt không vậy thầy?

 

[doveandrose]

cho em hỏi ngu 1 câu : "*" hoặc "%" so với "a" thì cái nào xếp trước ?

 

[chuot0106]

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

Tạm thời do tác giả không nói rõ nên code giải quyết trong trường hợp chuỗi không có dấu tiếng việt và không có kí tự đặc biệt.

Public Sub SapXepChuoi()
Dim i As Long, j As Long, chuoigoc As String, tmp As String
Dim kt As String, chuoicon As String, kt1 As String
    chuoigoc = "abcdefghijkomnpqr"
    chuoicon = "Ba cho con"
For i = 1 To Len(chuoigoc)
        kt = Mid(chuoigoc, i, 1)
    For j = 1 To Len(chuoicon)
        kt1 = Mid(chuoicon, j, 1)
        If Application.Proper(kt1) = Application.Proper(kt) Then tmp = tmp & kt1
    Next j
Next i
    MsgBox tmp
End Sub

 

[doveandrose]

trong lúc chờ tác giả xác định thì cho em nghịch dại cái này vậy

Public Function hello(ByVal old_str As String) As String
Application.ScreenUpdating = False
Dim ws As Worksheet, arr As Variant, rng As Range, n As Integer
If old_str = "" Then
    hello = ""
    Exit Function
End If
Set ws = ThisWorkbook.Worksheets.Add
ReDim arr(1 To Len(old_str), 1 To 1)
For n = 1 To Len(old_str) Step 1
    arr(n, 1) = Mid(old_str, n, 1)
Next
Set rng = ws.Range("A1:A" & UBound(arr))
rng.Value = arr
rng.Sort key1:=rng, order1:=xlAscending, MatchCase:=True
hello = WorksheetFunction.Trim(Join(WorksheetFunction.Transpose(rng.Value), ""))
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function

 

[Let'GâuGâu]

Ví dụ tôi có chuỗi:

"Ba cho con"

Các bạn vết dùm macro để nó cho kết quả "aBcchnoo"

em xin nộp bài, nhưng mà chỉ có " Ba cho con" thôi nha thầy,,,"Ba cho con gái" thì em chịu

Public Function BaChoCon(rng As Range)
Dim st As String, tam(1 To 1000)
st = Trim(rng.Value)
For i = 1 To Len(st)
    tam(Asc(UCase(Mid(st, i, 1)))) = tam(Asc(UCase(Mid(st, i, 1)))) & Mid(st, i, 1)
Next
   BaChoCon = Trim(Join(tam, ""))
End Function

 

[SA_DQ]

Đề cương giải bài "Xếp lại trật tự cho 1 chuỗi" cho những người biết về biến mảng

Bằng cách viết hàm tự tạo:
Function XepChuoi("Chuỗi khảo sát")
Bước 1: Khai báo biến
1.1 Khai báo 1 hằng kiểu chuỗi = "ABCD.. . Z"
1.2 Khai báo 1 mảng gồm 26 hàng & số cột bằng chiều dài của chuỗi khảo sát (CKS)
1.3 Khai báo 1 biến đếm kiểu Byte (VT) & 1 biến đếm (J) kiểu Long (hay Integer)
1.4 Khai báo 1 biến kiểu chuỗi (Tmp)

Bước 2: Tạo vòng lặp duyệt từ đầu chí cuối CKS theo J
Cắt từng kí tự cho vô biến Tmp
Tìm kí tự đang chứa ở Tmp trong hằng bằng hàm InStr(); Giá trị tìm thấy gán vô biến VT
Nếu tìm thấy thì chép vô mảng tại dòng trùng với VT & cột trùng với vị trí của Tmp trong CKS
Nếu không tìm thấy thì
Tiếp tục tìm với hàm UCase$(Tmp)
& cũng chép vô mảng như trên đã nêu

Bước 3:
Lập vòng lặp duyệt qua các hàng của mảng (theo J)
Lập vòng lặp thứ 2 duyệt theo các cột của mảng (Theo VT)
Thực hiện tuần tự việv nối chuỗi, như
XepChuoi = XepChuoi & Arr(J, VT)
Next VT
Next J
End Function

 

[doveandrose]

em xin nộp bài, nhưng mà chỉ có " Ba cho con" thôi nha thầy,,,"Ba cho con gái" thì em chịu

Public Function BaChoCon(rng As Range)
Dim st As String, tam(1 To 1000)
st = Trim(rng.Value)
For i = 1 To Len(st)
    tam(Asc(UCase(Mid(st, i, 1)))) = tam(Asc(UCase(Mid(st, i, 1)))) & Mid(st, i, 1)
Next
   BaChoCon = Trim(Join(tam, ""))
End Function

cho phỏng vấn vui tí
theo ý bạn thì chuỗi "BbbB" đã được gọi là xếp xong chưa ? hay cần phải là "BBbb"

 

[Let'GâuGâu]

cho phỏng vấn vui tí
theo ý bạn thì chuỗi "BbbB" đã được gọi là xếp xong chưa ? hay cần phải là "BBbb"

cái đó tùy biến được mà..........tại thầy ra đề sao thì làm vậy............heheheheh

 

[SA_DQ]

Cho phỏng vấn tí
Theo ý bạn thì chuỗi "BbbB" đã được gọi là xếp xong chưa ?

Theo mình thì sau khi chạy macro hay hàm, ta vẫn nhận được chuỗi 'BbbB' là đúng í đồ của bài đề ra;

Rất cảm ơn các bạn đã, đang & sẽ quan tâm đến topic này!

 

[seikoqn]

trong lúc chờ tác giả xác định thì cho em nghịch dại cái này vậy

Public Function hello(ByVal old_str As String) As String
Application.ScreenUpdating = False
Dim ws As Worksheet, arr As Variant, rng As Range, n As Integer
If old_str = "" Then
    hello = ""
    Exit Function
End If
Set ws = ThisWorkbook.Worksheets.Add
ReDim arr(1 To Len(old_str), 1 To 1)
For n = 1 To Len(old_str) Step 1
    arr(n, 1) = Mid(old_str, n, 1)
Next
Set rng = ws.Range("A1:A" & UBound(arr))
rng.Value = arr
rng.Sort key1:=rng, order1:=xlAscending, MatchCase:=True
hello = WorksheetFunction.Trim(Join(WorksheetFunction.Transpose(rng.Value), ""))
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function

Hướng dẫn mình cách sử dụng hàm này với được không bạn? Tôi thử nhập: =hello("Ba cho con") nhưng không ra kết quả!

 

[ChanhTQ@]

Hướng dẫn mình cách sử dụng hàm này với được không bạn? Tôi thử nhập: =hello("Ba cho con") nhưng không ra kết quả!

Bạn có thể thử hàm này trong cửa sổ Immediate

 

[Hau151978]

Hướng dẫn mình cách sử dụng hàm này với được không bạn? Tôi thử nhập: =hello("Ba cho con") nhưng không ra kết quả!

Function gọi trên sheet không được thay đổi trực tiếp nội dung của sheet, workbook, chỉ dùng trong cửa sổ VBA thôi. Ví dụ Function đơn giản sau

Function a()
Range("A1")=1
a=2
End Function

Function này khi gọi từ function hay sub khác thì được nhưng khi gọi từ sheet sẽ báo lỗi.
Function của mình sẽ loại các ký tự đặc biệt, chỉ giữ lại "a" đến "z" và "A" đến "Z"; kết quả xếp thứ tự, nếu có cả "a" và "A" thì ký tự nào có trước sẽ xếp trước.

Function XepChuoi$(ByVal s$)
    Dim tmp$, i&, j&
    i = 1
   
    Do While i <= Len(s)
        tmp = Mid(s, i, 1)
        If LCase(tmp) < "a" Or LCase(tmp) > "z" Then
            s = Replace(s, tmp, "")
        Else
            i = i + 1
        End If
    Loop
    For i = 1 To Len(s) - 1
       For j = i + 1 To Len(s)
            If LCase(Mid(s, i, 1)) > LCase(Mid(s, j, 1)) Then
                tmp = Mid(s, i, 1)
                Mid(s, i, 1) = Mid(s, j, 1)
                Mid(s, j, 1) = tmp
            End If
        Next
    Next
    XepChuoi = s
            
End Function

P/s: làm xong mới đọc hướng dẫn và các code của các bác, mình làm ngược lại nên code dài hơn và chậm hơn!

 

[ChanhTQ@]

Đây là những gì mình làm gần giống với fương án #140

Option Explicit
Function Xep(StrC As String) As String
 Const Alf$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 Dim J%, ViTri As Byte, Tmp$
 ReDim Arr(1 To Len(StrC), 1 To 26)
 
 For J = 1 To Len(StrC)
    Tmp = Mid(StrC, J, 1)
    ViTri = InStr(Alf, Tmp)
    If ViTri Then
        Arr(J, ViTri) = Tmp
    Else
        ViTri = InStr(Alf, UCase$(Tmp))
        If ViTri Then
            Arr(J, ViTri) = Tmp
        End If
    End If
 Next J
 For J = 1 To 26
    For ViTri = 1 To Len(StrC)
        Xep = Xep & Arr(ViTri, J)
    Next ViTri
 Next J
End Function

Còn đây là mình lượm được trên xa lộ:

Option Explicit
Function Alfabit(sInp As String) As String
    Const sLtr        As String = "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ"
    Dim sChr          As String
    Dim J             As Long
     
    For J = 1 To Len(sLtr)
        sChr = Mid(sLtr, J, 1)
        Alfabit = Alfabit & String(Len(sInp) - Len(Replace(sInp, sChr, "", 1, -1, vbBinaryCompare)), sChr)
    Next J
End Function

 

[doveandrose]

thật sự rất vui và cảm ơn các thầy giáo cô giáo đưa ra những tình huống này coi như những bài học cho lớp hậu bối chúng em .
người ta nói tiểu tiết bất đạt đại sự hà vi . những bài học nhỏ này là 1 cách rèn luyện tư duy để chúng em có thể giải quyết được những project VBA gặp phải trong tương lai . rất mong quý thầy cô duy trì những topic như này

chỉ góp ý nhỏ bài này người ra đề nên nói ngay từ đầu chuỗi cần xếp gồm những kí tự như thế nào để người làm đỡ mất công đi lòng vòng.cảm ơn

 

[SA_DQ]

[thongbao]
chỉ góp ý nhỏ bài này người ra đề nên nói ngay từ đầu chuỗi cần xếp gồm những kí tự như thế nào để người làm đỡ mất công đi lòng vòng.cảm ơn [/thongbao]

Có khi đi lòng vòng như bạn nói là 1 sự cần thiết, để:

Có vấp ngã, mới có thành công; Ví như bạn viết cho 1 trường hợp hẹp (đúng i sì đề bài iêu cầu & đã đạt kết quả); Sau đó bạn thử với những từ có dấu sắc & huyền,. . . thì thấy được 1 số kết luận khác rút ra từ việc làm "bậy" đó

Người ta ai thường là vầy: Đi từ đơn giản đến fức tạp, đi từ thấp lên cao;
Nếu ai cũng bắt đầu từ những fức tạp trước thì sẽ gặp khó nhiều hơn,. . .
Rất mừng là nhiều bạn đã quan tâm đến loạt bài này & xin hết sức cảm ơn!

 

[SA_DQ]

BT: Hàm để cắt bỏ các ký số trong chuỗi

Các bạn viết dùm 1 hàm có chức năng xóa bớt đi các kí số trong chuỗi, như:

"Anh gởi em 9999 bức thư" => "Anh gởi em bức thư"
"Printer 1200xb 30 inch" => "Printer 1200xb inch"

 

[Hau151978]

Các bạn viết dùm 1 hàm có chức năng xóa bớt đi các kí số trong chuỗi, như:

"Anh gởi em 9999 bức thư" => "Anh gởi em bức thư"
"Printer 1200xb 30 inch" => "Printer 1200xb inch"

Em xin mở hàng:

Function XXX$(ByVal s$)
    Dim arr, i&
    arr = Split(s, " ")
    For i = LBound(arr) To UBound(arr)
        If IsNumeric(arr(i)) Then arr(i) = ""
    Next
    XXX = Application.Trim(Join(arr, " "))
End Function

 

[SA_DQ]

Các bạn có thể thử sức thêm với việc không xài đến các hàm

    [B]Split(s, " ") &
    Join(arr, " ") [/B]

như trên không vậy???

 

[phihndhsp]

Function Tach(str) As String
Dim Kq As String
Dim chantren As Long
chantren = 1
Kq = ""
str = str & " "
For i = 2 To Len(str)
If (Mid(str, i, 1) = " ") Then
   If IsNumeric(Mid(str, chantren, i - chantren)) = False Then
        Kq = Kq & Mid(str, chantren, i - chantren)
    End If
    chantren = i
 End If
Next
 Tach = Kq
End Function

Cây nhà lá vườn không bẫy lỗi gì hết tạm thời thử 2 đáp án của bác SA điều cho kết quả hợp lệ

 

[VetMini]

Em xin mở hàng:

Function XXX$(ByVal s$)
    Dim arr, i&
    arr = Split(s, " ")
    For i = LBound(arr) To UBound(arr)
        If IsNumeric(arr(i)) Then arr(i) = ""
    Next
    XXX = Application.Trim(Join(arr, " "))
End Function

Không cần phải dùng chỉ số i. Dùng thẳng từng phần tử như thế này là đủ
For each e in Split(s, " ")
If IsNumeric(e) Then e = ""
Next e

Function Tach(str) As String
Dim Kq As String
Dim chantren As Long
chantren = 1
Kq = ""
str = str & " "
For i = 2 To Len(str)
If (Mid(str, i, 1) = " ") Then
   If IsNumeric(Mid(str, chantren, i - chantren)) = False Then
        Kq = Kq & " " & Mid(str, chantren, i - chantren)
    End If
    chantren = i
 End If
Next
 Tach = Kq
End Function

Cây nhà lá vườn không bẫy lỗi gì hết tạm thời thử 2 đáp án của bác SA điều cho kết quả hợp lệ

Bài này cho kết quả sai. Kết quả thêm một khoảng trắng vào mỗi đầu từ.

@@@ Duyệt chuỗi rắc rối thì RegEx là công cụ hiệu nghiệm nhất. Bạn nào thử xem.

 

[doveandrose]

bài #152 có nhắc đến chữ "&" . trong bài giải không được có kí tự này thì em chịu rồi . chờ cao nhân vậy

 

[VetMini]

bài #152 có nhắc đến chữ "&" . trong bài giải không được có kí tự này thì em chịu rồi . chờ cao nhân vậy

Quý vị có thói quen dùng phép nối chuỗi để thực hiện việc tạo chuỗi.
Bình thường có thể dùng hàm MID để thực hiện việc thay thế ký tự, vừa hiệu quả hơn, hoàn toàn không đụng chạm gì đến nối chuỗi.

 

[SA_DQ]

bài #152 có nhắc đến chữ "&" . trong bài giải không được có kí tự này thì em chịu rồi . chờ cao nhân vậy

Bài í nói rằng thử không xài hai hàm thôi; '&' không fải là hàm; Tác giả viết sai chính tả í mà!

Bài này có thể dùng
Do
Loop

 

[doveandrose]

nếu được xài "&" thì cho em sinh hoạt phát

Public Function tachHello(ByVal cel As Range) As String
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\s\d+\.?\d*\s"
    tachHello = WorksheetFunction.Trim(.Replace(" " & Replace(cel.Value, " ", "  ") & " ", ""))
End With
End Function

 

[phihndhsp]

nếu được xài "&" thì cho em sinh hoạt phát

.Pattern = "\s\d+\.?\d*\s"

có thể sửa lại ngắn như vầy cũng được
.Pattern = "\s\d+\s"

 

[doveandrose]

có thể sửa lại ngắn như vầy cũng được
.Pattern = "\s\d+\s"

1 câu mà cứ hỏi bác ba phi hoài ngại quá
"28.5 kg/thùng" ta lấy sao ?

 

[phihndhsp]

1 câu mà cứ hỏi bác ba phi hoài ngại quá
"28.5 kg/thùng" ta lấy sao ?

Cảm ơn bạn kiểu này chắc rút kinh nghiệm nhiều lần mới nhớ

 

[VetMini]

nếu được xài "&" thì cho em sinh hoạt phát

Public Function tachHello(ByVal cel As Range) As String
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\s\d+\.?\d*\s"
    tachHello = WorksheetFunction.Trim(.Replace(" " & Replace(cel.Value, " ", "  ") & " ", ""))
End With
End Function

Điều kiện tìm số khá đơn giản. Đâu có cần phải nối thêm " "
.Pattern = "\b\d+\b"
tachHello = WorksheetFunction.Trim(.Replace(cel, ""))

 

[ChanhTQ@]

Trong đề bài có 2 ví dụ, 1 là tiếng Việt (3,14159) & 1 là tiếng Anh (3.14)

 

[VetMini]

Dùng hàm MID, không cần nối chuỗi

Function ttt(ByVal s As String) As String
dim i as integer ' đầu từ
dim j as integer ' cuối từ
dim k as integer ' chiều dài từ
dim l as integer ' chiều dài chuỗi
l = Len(s)
i = 1
Do While i > 0
j = InStr(i + 1, s, " ")
k = IIf(j > 0, j, l) - i + 1
If IsNumeric(Mid(s, i, k)) Then Mid(s, i, k) = Space(k)
i = j
Loop
ttt = Application.Trim(s)
End Function

 

[Hau151978]

Không cần phải dùng chỉ số i. Dùng thẳng từng phần tử như thế này là đủ
For each e in Split(s, " ")
If IsNumeric(e) Then e = ""
Next e

Nếu chỉ như thế thì code sẽ thay thế biến e mà chuỗi s vẫn giữ nguyên nên không ra kết quả. Em sửa lại thành

Function abc(ByVal s$)
    Dim e
    For Each e In Split(s, " ")
        If Not IsNumeric(e) Then abc = abc & e & " "
    Next
    abc = Application.Trim(abc)
End Function

 

[doveandrose]

If IsNumeric(Mid(s, i, k)) Then Mid(s, i, k) = Space(k)

xem code các thầy mới thấy mình bị mất căn bản nặng
trước giờ em chỉ nghĩ rằng 1 function chỉ có chức năng return value
mong thầy giải thích 1 tí về Mid(s, i, k) = Space(k) để em được định hướng lại

 

[VetMini]

@Hau151978: đúng rồi, tôi quên.

 

[ndu96081631]

xem code các thầy mới thấy mình bị mất căn bản nặng
trước giờ em chỉ nghĩ rằng 1 function chỉ có chức năng return value
mong thầy giải thích 1 tí về Mid(s, i, k) = Space(k) để em được định hướng lại

Hàm Mid ngoài khả năng "lấy ra" thì nó còn có thêm khả năng "gán vào"
Gõ đoạn này vào cửa sổ Immediate và tự.. suy luận:

tmp = "A[COLOR=#ff0000]x[/COLOR]CD": Mid(tmp,2,1) ="[COLOR=#ff0000]B[/COLOR]": ?tmp

 

[VetMini]

xem code các thầy mới thấy mình bị mất căn bản nặng
trước giờ em chỉ nghĩ rằng 1 function chỉ có chức năng return value
mong thầy giải thích 1 tí về Mid(s, i, k) = Space(k) để em được định hướng lại

Tôi đã từng giải thích hơn một lần rồi.
Biến trên thực tế là một địa chỉ trỏ vào vùng nhớ. Các biến có dạng cỡ nhất định (như integer 4 bytes, Floast 8 bytes,...) thuộc về loại thay đổi được. Mỗi lần cần thay đổi, code chỉ việc dò theo địa chỉ và thay đổi trị trong vùng nhớ.
Chuỗi không đơn giản như vậy. Bởi vì chuỗi không có độ dài nhất định cho nên chúng thuộc về loại có giá trị không thay đổi được. Tiếng trong nghề gọi là 'immutable'.
Để thay đổi chuỗi, thật ra các ngôn ngữ như VBA phải bỏ chuỗi cũ và lập lại chuỗi trong một vùng nhớ khác. Vì vậy các phép tính thay đổi chuỗi được coi là tốn năng lượng.
Để khắc phục phần nào vấn đề tốn năng lượng này, các ngôn ngữ làm việc với chuỗi đều có các hàm hoặc lệnh thay đổi mà vẫn giữ vùng nhớ cũ - với diều kiện là độ dài không thay đổi.
Trong VBA, hàm này là hàm MID
Mid(s,i,k) = Space(k), có nghĩa là gán trị k khoảng trống vào chuỗi s nhưng không thay đổi chuỗi hoàn toàn, chỉ thay ở khoảng từ vị trí i, và chỉ thay đổi k ký tự.
Trong lệnh này s vẫn là chuỗi cũ, ở đúng vị trí cũ trong bộ nhớ, chỉ có các ký tự từ i đến i+k-1 thay đổi thôi.
Lệnh tương đương là
s = Left(s, i-1) & Space(k) & Mid(s,i+k,len(s))
Tuy tương đương với lệnh trước về kết quả, nhưng trên thực tế, lệnh này buộc VBA phải bỏ chuỗi s cũ và lập chuỗi s mới ở một vùng nhớ khác.

 

[SA_DQ]

Bài tập "Chuyển dữ liệu sang bảng"

Tôi có danh sách 500 các em HS (học sinh) theo mã vừa nhập trường; Danh sách đã được thêm 2 cột, đó là tên 10 lớp ( từ A, B, . . . , J) & tiêu chuẩn mà các em HS này đã đạt được (từ 1 đến 100)
Danh sách đó có dạng như sau:

TT |  Ma |L|TC
001|BXT00|A|01
002|BXP00|J|02
003|NVH00|C|04
...|. ...|.|..
500|TMH03|H|99

Nhiệm vụ đầ ra của bài tập là chuyển trang dữ liệu này thành bảng liệt kê theo 10 cột (ứng với 10 lớp) & 50 dòng
như bảng sau:

   |  A  |  B |  C  | . .|.|  J
 01|BXT00|    |     |..|. .|BXP00
02 |. . .| .  |NVH00|  |   |
. .| . . |.  .|. . .| .|...|. . . .
50 |.. ..|..  |.. ..||TMH03|. . .

Em TMH03 thuộc lớp [H] & ở dòng 50 (do TC em này là 99)
Như vậy các em có TC = 1 & TC = 2 vô cùng dòng 1.
Xin các bạn xem file.

 

[doveandrose]

không hiểu lắm . có thể là như vầy chăng ?

Public Sub hello()

Dim arr As Variant, lr As Long, r As Long, dArr(1 To 50, 1 To 10) As String
Dim colNum As Integer, colNames As String, rowNum As Integer
colNames = "ABCDEFGHIJ"
lr = Sheet1.Range("B60000").End(xlUp).Row
If lr > 1 Then
    arr = Sheet1.Range("B2:D" & lr).Value
    For r = 1 To lr - 1 Step 1
        colNum = InStr(colNames, UCase(arr(r, 2)))
        rowNum = WorksheetFunction.RoundUp(arr(r, 3) / 2, 0)
        dArr(rowNum, colNum) = dArr(rowNum, colNum) & "|" & arr(r, 1)
    Next
    
    Sheet2.Range("B2:K51").Value = dArr
    Sheet2.Columns("B:K").AutoFit
End If

End Sub

 

[SA_DQ]

Rất cảm ơn bạn đã nhiệt tình tham gia giải bài!


Trong cửa sổ Immediate ta nhập dòng lệnh sau:

? 35\2

Nó sẽ hướng ta có thể sửa lại câu lệnh

RowNum = WorksheetFunction.RoundUp(Arr(R, 3) / 2, 0)

thành cách viết khác.

 

[VetMini]

Bài giải #171 không hoàn hảo lắm.
@chủ đề: nếu bạn đọc kỹ bài giải #171 thì bạn cũng thấy là chính đề của mình còn thiếu sót.

 

[ChanhTQ@]

[thongbao]@chủ đề: nếu bạn đọc kỹ bài giải #171 thì bạn cũng thấy là chính đề của mình còn thiếu sót.[/thongbao]

Hiện nay đề văn cho các em HS được thầy/cô cho dạng "mở"
Sao ta lại không thể cho đề VBA dạng "mở", nhỉ? Cũng là dịp để mọi người thảo luận mà!

Chúc vui cuối tuần!

 

[ChanhTQ@]

Bài tập: Tạo lịch các ngày trong tuần của 1 tháng như hình kèm theo

Trên hình là kết quả chạy macro sự kiện tại ô [S1] hiện ra các ngày cùng các thứ của tháng 3 năm 2015; (số 2015 ở ô [U1])
Các bạn viết dùm macro này.

Một số gợi í cho những người mới bắt đầu:

B1: Tính ra ngày đầu của tháng & năm đã chọn (1/3/2015)
B1.1: Tính xem nó thuộc vào thứ nào trong tuần;

B2: Cọng thêm số ngày nào đó tương ứng để ta tìm ra ngày đầu tuần 1 của tháng; Như trong hình ngày 1/3 năm này là Chủ nhật; ta cần trừ đi 6 để có ngày 23/02/2015

B3: Ta tạo ra 2 vòng lặp: Theo hàng (các tuần trong tháng này) & theo cột (các ngày trong 1 tuần) để rãi các ngày lên trang tính.

Chúc các bạn thành công & có ngày nghỉ cuối tuần vui vẻ!

 

[doveandrose]

thấy có hình vẽ và gợi ý thôi chứ đâu biết phải làm gì đâu

 

[ndu96081631]

thấy có hình vẽ và gợi ý thôi chứ đâu biết phải làm gì đâu

Thì bài tập là TẠO LỊCH đó!

 

[Ba Tê]

Trên hình là kết quả chạy macro sự kiện tại ô [S1] hiện ra các ngày cùng các thứ của tháng 3 năm 2015; (số 2015 ở ô [U1])
Các bạn viết dùm macro này.

Một số gợi í cho những người mới bắt đầu:

B1: Tính ra ngày đầu của tháng & năm đã chọn (1/3/2015)
B1.1: Tính xem nó thuộc vào thứ nào trong tuần;

B2: Cọng thêm số ngày nào đó tương ứng để ta tìm ra ngày đầu tuần 1 của tháng; Như trong hình ngày 1/3 năm này là Chủ nhật; ta cần trừ đi 6 để có ngày 23/02/2015

B3: Ta tạo ra 2 vòng lặp: Theo hàng (các tuần trong tháng này) & theo cột (các ngày trong 1 tuần) để rãi các ngày lên trang tính.

Chúc các bạn thành công & có ngày nghỉ cuối tuần vui vẻ!

Thất nghiệp, làm "ABC" một chút coi sao.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Thang As Long, Nam As Long, Col As Long, Rws As Long, Edate As Long, I As Long
If Target.Address = "$S$1" Then
    Set Rng = Range("P3:V8")
        Rng.ClearContents
        Thang = Range("S1").Value
        Nam = Range("U1").Value
        Edate = Day(DateSerial(Nam, Thang + 1, 0))
        Rws = 1
        For I = 1 To Edate
            Col = Weekday(DateSerial(Nam, Thang, I), 2)
            Rng(Rws, Col).Value = I
                If Col = 7 Then Rws = Rws + 1
        Next I
    Set Rng = Nothing
End If
End Sub

 

[doveandrose]

hổng chịu à nhà . các học sinh chưa nộp bài mà thầy giáo giải luôn là sao ?

Public Sub helloDay(ByVal whatMonth As Integer, ByVal whatYear As Integer)


Dim arr(1 To 6, 1 To 7), r As Long, fd As Long, ld As Long, weekTh As Integer
fd = CLng(DateSerial(whatYear, whatMonth, 1))
ld = CLng(DateSerial(whatYear, whatMonth + 1, 0))


For r = fd To ld Step 1
    arr(weekTh + 1, Weekday(r, vbMonday)) = Day(r)
    If Weekday(r, vbMonday) = 7 Then weekTh = weekTh + 1
Next
Sheet1.Range("P4:V9").Value = arr


End Sub

 

[Vo Tinh]

Em nộp bài và nghĩ là đây mới đúng bài người mới học VBA, cặm cụi theo các bước hướng dẫn

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim firstDayOfMonth As Date
Dim dayOfWeek As Integer
Dim firstDayOfFirstWeek As Date
Dim D As Integer
Dim W As Integer
firstDayOfMonth = DateValue(Cells(1, "u").Value & "/" & Cells(1, "s").Value & " / 1")
dayOfWeek = Weekday(firstDayOfMonth, vbMonday)
firstDayOfFirstWeek = firstDayOfMonth - dayOfWeek + 1
For W = 0 To 5
For D = 0 To 6
Cells(3 + W, Chr(80 + D)).Value = firstDayOfFirstWeek + D + (7 * W)
Next D
Next W
End Sub

Các Thầy góp ý cho ạ

 

[SA_DQ]

[Thongbao] Vo Tinh;654437:[/ThongBao]
Có thể xài 1 vòng lặp, như macro sự kiện sau:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, Cls As Range
 Dim Thang%, Nam%, Wek%, J%, Dat&
 
 If Not Intersect(Target, [J1]) Is Nothing Then
    Set Rng = [G3].Resize(6, 7)
    Rng.Value = ""
    Thang = Target.Value:       Nam = [U1].Value
    Dat = DateSerial(Nam, Thang, 1)
    Wek = Weekday(Dat)
    Dat = Dat - Choose(Wek, 6, 0, 1, 2, 3, 4, 5)
    For Each Cls In Rng
        If Month(Dat + J) = Thang Then
            Cls.Value = Day(Dat + J)
        End If
        J = J + 1
    Next Cls
End If
End Sub

Có nghĩa là bài này có rất nhiều cách. Rất mong sự tìm tòi của các bạn khác nữa để thêm fần xôm tụ!

Chúc ngày nghỉ cuối tuần vui vẻ & chất lượng!

 

[ndu96081631]

Bài tập: Tạo lịch các ngày trong tuần của 1 tháng như hình kèm theo

Bài này không khó nhưng nếu dùng code sự kiện thì việc bẫy lỗi mới thật sự là đáng sợ (nghĩ ra mọi tình huống mà người dùng cố tình "phá")
Chưa thấy ai viết code để ý đến chuyện này nhỉ?

 

[SA_DQ]

[thongbao]Chưa thấy ai viết code để ý đến chuyện này nhỉ? [/thongbao]

(/ì có thể ô để chọn tháng người ta thiết kế là chỉ chọn được từ số 1 đến số 12 mà thôi;

Cũng như vậy với ô chứa số biểu thị của năm của lịch cần làm.

Xin mọi người quan tâm & tiếp tục tham gia.

 

[ndu96081631]

[thongbao]Chưa thấy ai viết code để ý đến chuyện này nhỉ? [/thongbao]

(/ì có thể ô để chọn tháng người ta thiết kế là chỉ chọn được từ số 1 đến số 12 mà thôi;

Cũng như vậy với ô chứa số biểu thị của năm của lịch cần làm.

Sư phụ muốn nói đến Validation chăng? Vẫn copy/paste giá trị tào lao vào được mà sư phụ

 

[SA_DQ]

Sp muốn nói đến Validation chăng? Vẫn copy/paste giá trị tào lao vào được mà sư phụ

Xung quanh toàn là giặc thì làm sao sống nổi đây ta?!?

 

[anhdepjai]

Thảo có thể xài dòng lệnh này:

Rng(iR, 5).Resize(, Rng(iR, jC)).Interior.ColorIndex = 33 + Cells(iR + 2, jC + 1).Value

Thay vì fải thiết kế vùng bảng màu

Hic, Thế này mà là mới bắt đầu ah?
Em con if với then lằng nhà lằng nhằng

 

[SA_DQ]

Hic, Thế này mà là mới bắt đầu ah?
Em con if với then lằng nhà lằng nhằng

Cảm ơn bạn đã quan tâm!

Ở đâu mà bạn tránh được "IF . . . Then"!

 

[SA_DQ]

Bài tập: Xác định "Ngày của cha" hàng năm bằng hàm tự tạo.

Các bạn viết giúp hàm tự tạo để khi nó được cung cấp con số chỉ năm (1930,. . . ,2029) bất kì, thì hàm trả về ngày chủ nhật thứ ba của tháng sáu năm đó.

 

[kuldokk]

Các bạn viết giúp hàm tự tạo để khi nó được cung cấp con số chỉ năm (1930,. . . ,2029) bất kì, thì hàm trả về ngày chủ nhật thứ ba của tháng sáu năm đó.

Em chơi:

Function findDate(year, Optional month, Optional day_of_week, Optional nth)    
    If IsMissing(month) Then month = 6    
    If IsMissing(day_of_week) Then day_of_week = 1    
    If IsMissing(nth) Then nth = 3    

    findDate = DateSerial(year, month, 1 + 7 * nth) - Weekday(DateSerial(year, month, 8 - day_of_week))
End Function

' hoặc ngắn hơn:

Function findDate(year, Optional month = 6, Optional day_of_week = 1, Optional nth = 3)
    findDate = DateSerial(year, month, 1 + 7 * nth) - Weekday(DateSerial(year, month, 8 - day_of_week))
End Function

Sử dụng:

Year: năm cần tính​

Month: tháng cần tính (mặc định: tháng 6)
day_of_week: ngày cần tính trong tuần( mặc định chủ nhật = 1)
nth: là day_of_week thứ mấy (mặc định thứ 3)​

findDate(2015) = 6/21/2015 
findDate(2014) = 6/15/2014

 

[doveandrose]

Các bạn viết giúp hàm tự tạo để khi nó được cung cấp con số chỉ năm (1930,. . . ,2029) bất kì, thì hàm trả về ngày chủ nhật thứ ba của tháng sáu năm đó.

nhìn bài này em nhớ lại ngày xưa đi học vi tính lấy bằng A bị thầy giáo đố 1 bài đơ luôn :
đếm xem 1 năm bất kì có bao nhiêu cái thứ 6 ngày 13 ?

 

[VetMini]

nhìn bài này em nhớ lại ngày xưa đi học vi tính lấy bằng A bị thầy giáo đố 1 bài đơ luôn :
đếm xem 1 năm bất kì có bao nhiêu cái thứ 6 ngày 13 ?

Toán vi tính khác với VBA. Trong VBA có sẵn nhiều hàm làm việc với ngày tháng. Trong cái ngôn ngữ nào đó thầy giáo bạn dùng để dạy vi tính chưa chắc có. Phương pháp phân tích giải thuật hầu như hoàn toàn khác nhau.

 

[ChanhTQ@]

Công thức này gợi í cho các bạn mới bắt đầu VBA:

=DATE(AA1,6,22)-WEEKDAY(DATE(AA1,6,21))

nhìn bài này em nhớ lại ngày xưa đi học vi tính lấy bằng; Thầy giáo đố luôn bài :
đếm xem 1 năm bất kì có bao nhiêu cái thứ 6 ngày 13 ?

Option Explicit
Function Thu6Ngay13(Nam%)
 Dim J%, Dat As Date, Dg As Byte
 ReDim Arr(1 To 12, 1 To 1)
 
 For J = 1 To 12
    Dat = DateSerial(Nam, J, 13)
    If Weekday(Dat) = 6 Then
        Dg = Dg + 1:        Arr(Dg, 1) = Format(Dat, "mm/dd/yy")
    End If
 Next J
 Thu6Ngay13 = Arr()
End Function

 

[VetMini]

... em nhớ lại ngày xưa đi học vi tính lấy bằng A bị thầy giáo đố 1 bài đơ luôn :
đếm xem 1 năm bất kì có bao nhiêu cái thứ 6 ngày 13 ?

Bây giờ đố ngược lại thầy giáo, không dùng vòng lặp, không dùng hàm ngày tháng, làm cách nào?

 

[Hau151978]

Bây giờ đố ngược lại thầy giáo, không dùng vòng lặp, không dùng hàm ngày tháng, làm cách nào?

- Lập bảng tra ứng với ngày 13/1 là thứ mấy và năm nhuận hay không thì cả năm có mấy thứ 6 ngày 13, bước này cộng bằng tay rồi lưu vào biến mảng.
- Tính thứ ngày 13 /1 theo công thức:
A=y + int(y/4) -int(y/100) +int(y/400)+4
Mod(A, 7) sẽ là thứ trong tuần. - Xác định năm nhuận hay không ( ((y mod 4=0) and (y mod 100 <>0)) or (y mod 400=0) ).
- Tìm số thứ 6 trong mảng ở bước 1.

 

[SA_DQ]

. . .

/(iểu đề ra này & cách giải chắc nên qua đây: http://www.giaiphapexcel.com/forum/showthread.php?7146-Đố-vui-về-VBA!
để đăng bài, chắc vậy!

 

[VetMini]

- Lập bảng tra ứng với ngày 13/1 là thứ mấy và năm nhuận hay không thì cả năm có mấy thứ 6 ngày 13, bước này cộng bằng tay rồi lưu vào biến mảng.
- Tính thứ ngày 13 /1 theo công thức:
A=y + int(y/4) -int(y/100) +int(y/400)+4
Mod(A, 7) sẽ là thứ trong tuần. - Xác định năm nhuận hay không ( ((y mod 4=0) and (y mod 100 <>0)) or (y mod 400=0) ).
- Tìm số thứ 6 trong mảng ở bước 1.

Đạ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ỏ.

 

[kuldokk]

Đạ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ỏ.

Em lười quá, cũng chẳng suy luận nữa, người ta suy luận hết rồi =))
https://en.wikipedia.org/wiki/Deter...bular_method_to_calculate_the_day_of_the_week

 

[VetMini]

Em lười quá, cũng chẳng suy luận nữa, người ta suy luận hết rồi =))
https://en.wikipedia.org/wiki/Deter...bular_method_to_calculate_the_day_of_the_week

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.

 

[Vo Tinh]

Các bạn viết giúp hàm tự tạo để khi nó được cung cấp con số chỉ năm (1930,. . . ,2029) bất kì, thì hàm trả về ngày chủ nhật thứ ba của tháng sáu năm đó.

Em cũng tham gia để học

Public Function FatherDay(ByVal yr As Date)Dim i%, k%, myDay As Date
If yr < 1900 Then Exit Function
For i = 1 To 30
myDay = DateSerial(yr, 6, i)
    If Weekday(myDay) = 1 Then
    k = k + 1
        If k = 3 Then
           FatherDay = Format(DateSerial(yr, 6, i), "dd / MM / yyyy")
           Exit Function
        End If
    End If
Next i
End Function

Các Thầy cho em hỏi muốn bẫy lỗi yr là chuỗi thì exit mình làm thế nào ạ

 

[SA_DQ]

Mình có vài í thế này:

(1) Câu lệnh
MyDay = DateSerial(yr, 6, i)
Như vậy ta cần cung cấp cho biến "yr" là 1 số, như 2001,2009,. . .
Đối chiếu với với câu

Public Function FatherDay(ByVal yr As Date)
là khập khiển & dễ gây hiểu lầm.
Bạn nên sửa lại câu này như:
Public Function FatherDay(ByVal yr As Integer)

(2) Bạn có thể không xài vòng lặp, mà lập bảng
Nếu 1/6/yr là chủ nhật thì ngày của cha là xx/06/yr (xx=?)
Nếu 1/6/yr là thứ hai thì ngày của cha là xx/06/yr (= xx +6)
. . . . . . . . .
. . . . . . . . .
Sau khi có bảng rồi, ta sẽ rút ra 1 qui luật khác ngắn hơn; đó là
=DATE(AA1,6,22)-WEEKDAY(DATE(AA1,6,21)) chính là "Ngày của Cha";
Đổi công thức này sang sang thành câu lệnh VBA là quá dễ; chỉ việc thay [AA1] bằng yr là xong thôi & trong tầm tay của bạn.

Chúc bạn có nhiều niềm vui trong công cuộc chinh fục VBA