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

[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

.
.
.

 

[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 ạ