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

ChanhTQ@ · 29/5/14

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:

(*) BĐT: Bài đọc thêm

.
.
.

doveandrose · 7/6/15

Let'GâuGâu đã viết:
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

Mã:

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 · 7/6/15

doveandrose đã viết:
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 · 7/6/15

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 · 7/6/15

doveandrose đã viết:

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

Mã:

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@ · 7/6/15

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 · 7/6/15

seikoqn đã viết:
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

Mã:

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.

Mã:

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@ · 8/6/15

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

Mã:

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ộ:

PHP:

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 · 8/6/15

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 · 9/6/15

[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 · 9/6/15

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 · 9/6/15

HYen17 đã viết:
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:

Mã:

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 · 10/6/15

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

Mã:

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

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

phihndhsp · 10/6/15

Mã:

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 · 10/6/15

Hau151978 đã viết:
Em xin mở hàng:

Mã:

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

phihndhsp đã viết:
Mã:

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 · 10/6/15

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 · 10/6/15

doveandrose đã viết:
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 · 10/6/15

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 · 10/6/15

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

Mã:

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 · 10/6/15

doveandrose đã viết:
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 · 10/6/15

phihndhsp đã viết:
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 ?

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

0901452không62

hello

Thành viên mới

/(hông là gì!

Thành viên hoạt động

0901452không62

Thành viên tích cực

0901452không62

hello

/(hông là gì!

/(hông là gì!

Thành viên tích cực

/(hông là gì!

Thành viên gạo cội

Ăn cùng góc phố

hello

Ăn cùng góc phố

/(hông là gì!

hello

Thành viên gạo cội

hello