Những bài tập VBA đơn giản dành cho những người mới bắt đầu

[SA_DQ]

Bài 01

Macro to merge values from one column into one cell and retain source formatting.
​

Example:

Source:
A1= "It is going to cost "
A2= "$1000.00" (A2 is formatted to underline value)

Destination: (desired result)
B2= "It is going to cost $1000.00" (A2 value is still underlined)

Đề bài có thể tóm gọn lại như sau:

Trên cột [A:A] ta có những dòng thuyết minh & dưới nó là những con số đã được định dạng bằng nhiều cách khác nhau để fân biệt như chữ in nghiên, chữ số được tô đậm hay Font có màu đỏ,. . . .

Macro có nhiệm vụ: Hễ dòng nào có số thì ô bên fải liền kề cần được mang nội dung cũa ô trên ô có số & bản thân số của ô đang xét; Mặt khác định dạng ô giống với ô mang số liệu

Chúc thành công

​

Bảng liệt kê:

TT | Tên bài | Tại | Diễn giải
01|Bài tập 01|#1|Nối chuỗi & định dạng
02|Bài tập 02 | #11|Thống kê số lần lặp
03|Bài tập 03|#19|Trích lọc danh sách theo năm
04|Bài tập 04|#27|Thêm dòng theo số liệu tháng - năm
05|Bài tập 05|#31|Tổng hợp số liệu hoạt động theo từng kỳ (tháng)
06|Bài tập 06|#73|Ghí chú ngày có chi fí lớn nhất trong từng tháng khảo sát
07|Bài tập 07|#84|Thêm dòng tính tổng, sau khi đã thống kê số liệu
08|Bài tập 08|#103|Kẻ dòng, viền khung & format báo cáo hoàn chỉnh
09| BT Fần B | #206 | (Ở đây có bảng liệt kê riêng)

Rất mong các bạn ủng hộ & hỗ trợ tối đa.
!

 

[Kh Biet]

Chào bạn Quanghai, chào bạn Dhn46
Cám ơn các bạn đã làm bài tập. có vài bài giải thế này, người mới học dễ so sánh các phương án hơn, do vậy dễ nhớ và nhớ lâu hơn. Bài giải của bạn Quanghai dễ hiểu, đơn giản hơn, bài của bạn Dhn46 thì dân lớp dưới bọn mình phải để "gặm" dần chắc mới hiểu được. Mình text thử thấy code của quanghai 2 cột tên ĐTượng nên mình chuyển qua trái 1 cột cho gọn hơn 1 chút :

Sub test2()
Dim i As Long
[E1] = [A1]: [F1] = "So Lan"
Range([A1], [A65536].End(3)).AdvancedFilter 2, , [E1], 2
For i = 2 To [E65536].End(3).Row
Cells(i, 6) = Application.CountIf([A:A], Cells(i, 5))
Next
End Sub

Mình mới nhập GPE là thật, mình muốn học là thật, Mình không biết là thật, và mình kính phục các thày và các bạn là thật. Mong các bạn đừng nghĩ sai về mình .
cám ơn các thày và các bạn.

à, mình hiểu ý Quanghai rồi . Bài 1 bạn để +1 để học viên phải tìm, bài 2 không cho kết quả hiện đúng cột yêu cầu để học viên phải sử lý. Cám ơn bạn .

 

[Quang_Hải]

Ở CQ (cơ quan) nọ người ta đã thống kê danh sách đạt danh hiệu LĐTT như bảng sau:

TT|HoTen|Nữ|NgaySnh|Quê/Tỉnh|ĐVị|2008|2009|2010|2011|2012
1|Hòa Nga Nhi|X|6/02/1980|Bình Fước|KT|X|X||X
2|Hà Hồ Ngọc||6/09/1981|Bình Tuy|Fx1|X||X|X|
3|Võ Nghi Vỹ||6/21/1980|Bình Định|KCS|X||X|X|x
|. . .|X|. . |.. .. ..||..||..||

Các bạn hãy tạo ra macro giúp đơn vị nọ lọc ra danh sách LĐTT của 1 năm nào đó bất kỳ;
Như trong hình dưới đây là lọc từ file đính kèm DS LĐTT năm 2008
(Chọn sự kiện năm tại ô [AE1])

Không ai mần hết thì thôi em ôn lại kiểu làm cơ bản lúc trước hay làm vậy
1. Khai báo cho có để không bị báo vàng vàng, vì chả hiểu lúc nào là range, lúc nào là as long...
2. Cứ từng cell mà copy, chả biết Union gì ráo. Vậy mà dễ học đấy, chứ chưa rành mấy cái này bày đặt lao vào mảng và CreateObject thì chả ra làm sao cả.
3. Còn sự kiện hả? Lúc em mới tham gia thì biết vẽ cái nút là mừng rồi

Sub loc()
Dim i, Icolumn
Range("AA2:AD1000").ClearContents
  Icolumn = Range("G1:K1").Find([AE1]).Column
   For i = 2 To [B65536].End(xlUp).Row
      If Cells(i, Icolumn) <> "" Then
         [AA65536].End(3).Offset(1) = [AA65536].End(3).Offset(1).Row - 1
         [AB65536].End(xlUp).Offset(1) = Cells(i, 2)
         [AC65536].End(xlUp).Offset(1) = Cells(i, 3)
         [AD65536].End(xlUp).Offset(1) = Cells(i, 6)
      End If
   Next
End Sub

PS: Code này mà không tìm thấy dữ liệu tại AE1 là lỗi

Khi khá hơn chút thì em làm cách này cho gọn. Sau đó dùng Autofilter hoặc Sort để loại những dòng không có chữ X

Sub loc_advanced()
Range([A1], [A65536].End(3)).Resize(, 11).AdvancedFilter 2, , [AA1:AE1]
End Sub

 

[SA_DQ]

Mình xin gợi í 1 cách khác, đó là AdvancedFilter

Các bạn chú í trong hình vẽ của đề bài sẽ thấy điều này:

Con trỏ đang kích hoạt ô [Ae2]; Mà trên thanh công thức ta thấy đánh dâu 'X'
Như vậy cụm [AE1:AE2] tạo thành vùng điều kiện lọc lý tưởng để chúng ta lọc từ vùng CSDL (Các cột từ [B:K]) sang các trường tại vùng [AB1:AD1]
Còn tại cột [AA] là ta cài sẵn công thức để đánh số thứ tự chỉ những dòng sau nó không rỗng.

Các bạn thử xem & chúc thành công.

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Em ham vui 1 tí nhé coi phải vậy không chị

Sub Test()
Range("AA2:AD16").ClearContents
Range("B1:K16").AdvancedFilter xlFilterCopy, Range("AE1:AE2"), Range("AB1:AD1")
With Range("AA2:AA" & Range("AB65000").End(xlUp).Row)
.FormulaR1C1 = "=ROW()-1"
.Value = .Value
End With


End Sub

 

[Quang_Hải]

Các bạn chú í trong hình vẽ của đề bài sẽ thấy điều này:

Con trỏ đang kích hoạt ô [Ae2]; Mà trên thanh công thức ta thấy đánh dâu 'X'
Như vậy cụm [AE1:AE2] tạo thành vùng điều kiện lọc lý tưởng để chúng ta lọc từ vùng CSDL (Các cột từ [B:K]) sang các trường tại vùng [AB1:AD1]
Còn tại cột [AA] là ta cài sẵn công thức để đánh số thứ tự chỉ những dòng sau nó không rỗng.

Các bạn thử xem & chúc thành công.

Lúc khá hơn tí nữa thì làm theo cách sư phụ gợi ý, nhưng sẽ hơi khó hiểu cho các bạn mới làm quen. Người đã biết như Thầy thì thấy đơn giản, nhưng người mới thì .. than ôi ... sao khó thế. Em cũng đã nắm sơ sơ rồi mà vẫn còn ngơ ngơ lắm

Sub loc_advancedfilter()
[AE2] = "X"
Range([A1], [A65536].End(3)).Resize(, 11).AdvancedFilter 2, [AE1:AE2], [AA1:AD1]
Range([AA2], [AA65536].End(3)) = [row(a:a)]
End Sub

Em ham vui 1 tí nhé coi phải vậy không chị

Người biết xài tuyệt chiêu này rõ ràng là cao thủ rồi...Hết chạy rồi nhá.

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Người biết xài tuyệt chiêu này rõ ràng là cao thủ rồi...Hết chạy rồi nhá.

Cao thủ gì đâu anh ơi, em mới mò mẫm thôi ạ, hình như code trên cũng chưa đúng với yêu cầu anh ạ.

Có điều này em bắt gặp ở file bài tập mẫu là khi em click vào filter thử thì có các địa chỉ ở ô điều kiện, Chị Hải Yến quên xóa đi do test thử. Nên em căn cứ vào đó mà record macro thôi

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AE$1" Then
    Range("AA2:AD16").ClearContents
    Range("B1:K16").AdvancedFilter xlFilterCopy, Range("AE1:AE2"), Range("AB1:AD1")    
    With Range("AA2:AA" & Range("AB65000").End(xlUp).Row)            
        .FormulaR1C1 = "=ROW()-1"            
        .Value = .Value    
    End With
End If
End Sub

 

[SA_DQ]

Bài tập số 4: Điền diễn giải các tháng của 1 khoảng các ngày.

​

| A | B | C | D 1 ||Ngày bắt đầu:| 2/16/2012 |
2 ||Ngày Kết thúc:| 11/30/2012 |
3 ||||
4|TT | Tháng khảo sát | Chi fí | Ghi chú 5 |1| Tháng 02/2012 ||
6 |2| Tháng 03/2012 ||
7 |3| Tháng 04/2012 ||
8 |4| Tháng 05/2012 ||
9 |5| Tháng 06/2012 ||
10 |6| Tháng 07/2012 ||
11 |7| Tháng 08/2012 ||
12 |8| Tháng 09/2012 ||
13 |9| Tháng 10/2012 ||
14 |10| Tháng 11/2012 ||
15 ||/||

Macro có nhiệm vụ điền vô cột từ dòng thứ 5 trở xuống theo giá trị ngày bắt đầu & ngày kết thúc mà người dùng nhập vô tại 2 ô [C1:C2]

(Vì người dùng đã nhập vô [c1] là 16/02/2012 nên ta fải điền chuỗi đầu tiên là "tháng 02/2012"
& ngày cuối đã nhập là 30/11/2012, nên dòng cuối sẽ fải là "Tháng 11/2012")
Trong bảng, macro cần điền các chuỗi màu xanh.

Rất mong các bạn tiếp tục hưởng ứng.

 

[xuan.nguyen82]

Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub

 

[concogia]

Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub

Cho I chạy từ Dau tới Cuoi ( 2 tới 11) không ghi Step thì mặc định bước nhảy là 1_ Giá trị ban đầu là 2
Gán giá trị cho biến Thang= Dau ( là 2 )
Túm lại lần 1: ban đầu I = Thang
Sau mỗi vòng lặp:
(1) I tăng lên 1 ==> I = I +1
và
(2) Thang= Thang + 1
Từ túm lại lần 1 & (1) & (2) ==> "sui gia" I = Thang
Túm lại lần cuối: biến Thang ........."thờ ưa dư huyền" THỪA
Híc,

 

[ChanhTQ@]

Nếu người dùng muốn khảo sát số liệu của Q IV năm trước tới hết Q.I năm nay thì sao?

Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Xin XN82 suy nghỉ tiếp đi nha, nhưng chớ có căng quá!

 

[SA_DQ]

Bài tập 05: Tổng hợp từ CSDL vô bảng tại đề bài 4

Cơ quan nọ cần tổng hợp số liệu chi fí của các tháng để ghi vô bảng mẫu tại bài 4 (#29)

CSDL có trong file đính kèm

​

(Bài này có thể có nhiều cách làm từ dễ đến khó; Mong các bạn tiếp tục hưởng ứng)

 

[Kh Biet]

Không ai mần hết thì thôi em ôn lại kiểu làm cơ bản lúc trước hay làm vậy
1. Khai báo cho có để không bị báo vàng vàng, vì chả hiểu lúc nào là range, lúc nào là as long...
2. Cứ từng cell mà copy, chả biết Union gì ráo. Vậy mà dễ học đấy, chứ chưa rành mấy cái này bày đặt lao vào mảng và CreateObject thì chả ra làm sao cả.
3. Còn sự kiện hả? Lúc em mới tham gia thì biết vẽ cái nút là mừng rồi

Sub loc()
Dim i, Icolumn
Range("AA2:AD1000").ClearContents
  Icolumn = Range("G1:K1").Find([AE1]).Column
   For i = 2 To [B65536].End(xlUp).Row
      If Cells(i, Icolumn) <> "" Then
         [AA65536].End(3).Offset(1) = [AA65536].End(3).Offset(1).Row - 1
         [AB65536].End(xlUp).Offset(1) = Cells(i, 2)
         [AC65536].End(xlUp).Offset(1) = Cells(i, 3)
         [AD65536].End(xlUp).Offset(1) = Cells(i, 6)
      End If
   Next
End Sub

PS: Code này mà không tìm thấy dữ liệu tại AE1 là lỗi

Cám ơn bạn!mình thấy bài giải này của bạn dễ hiểu,đơn giản, các bài giải sau kiến thức học viên đòi hỏi phải cao hơn, code gọn hơn nhưng thao tác nhiều hơn . mình có vấn đề cần hỏi các bạn : code của "anh chang ngoc" bài #36 ở trên mình coppy về chạy không đúng yêu cầu của đề. Mình sai chỗ nào nhỉ ? tìm không ra . Chắc tại dốt quá;Tập tin đính kèm.

 

[leonguyenz]

Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub

Nếu bắt đầu từ 15/07/1983 đến hôm nay 30/11/2012 code chạy bỏ mất 6 dòng đầu, và kết quả là được 05 tháng ?

 

[SAODOINGOI_XD]

Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub

Chỉnh sửa lại đoạn code của xuannguyen một chút.
1. Bỏ biến tháng do thừa như bác concogia phân tích
2. Thêm điều kiện mỗi lần chạy code thì xóa dử liệu cũ không thì dử liệu chồng chéo.
3. Sửa lại điều kiện như chạy dử liệu dòng đầu tiên là dòng thứ 5.

Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long
Range("A5:B6500").Clear
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
For I = Dau To Cuoi   
 STT = STT + 1    
Cells(STT + 4, 1).Value = STT  
  Cells(STT + 4, 2).Value = "thang " & Format(I, "00") & "/2012"
Next I
End With
End Sub

 

[Kh Biet]

Leonguyez ơi, Sao lại 15/07/1983 nhỉ ? mình không hiểu .

 

[Ba Tê]

Leonguyez ơi, Sao lại 15/07/1983 nhỉ ? mình không hiểu .

Do Leonguyenz gõ nhầm thôi.15/7/2012 ấy mà.
Code của XN gán dữ liệu vào dòng I+4 nên nếu bắt đầu bằng tháng 7 thì dòng đầu là dòng 11, bỏ trống từ dòng 5-10(6 dòng).

 

[SAODOINGOI_XD]

Cơ quan nọ cần tổng hợp số liệu chi fí của các tháng để ghi vô bảng mẫu tại bài 4 (#41)

CSDL có trong file đính kèm

​

(Bài này có thể có nhiều cách làm từ dễ đến khó; Mong các bạn tiếp tục hưởng ứng)

Hic hic bài này em làm thêm cột phụ, với lại năm chưa khắc phục được em đưa lên để các thầy chỉ thêm ạ.

Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, i As Long
Range("A5:B6500").Clear
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
For i = Dau To Cuoi    
STT = STT + 1   
Cells(STT + 4, 1).Value = STT  
Cells(STT + 4, 2).NumberFormat = """Tháng ""00""/2012"""   
 Cells(STT + 4, 2).Value = i    
Cells(STT + 4, 3).Value = Application.SumIf(Sheet4.[J:J], Cells(STT + 4, 2), Sheet4.[e:e])
Next i
End With
End Sub

Em định sử dụng hàm sumproduct luôn mà ko làm được.

 

[dhn46]

Sao bạn lại dùng Excel Function? Nếu Excel Function thì có hàm Edate cũng có thể giải quyết được đề bài đấy.
Ở đây nếu suy nghĩ theo kiểu 1 năm có 12 tháng thì sao nhỉ...?

 

[Kh Biet]

Do Leonguyenz gõ nhầm thôi.15/7/2012 ấy mà.
Code của XN gán dữ liệu vào dòng I+4 nên nếu bắt đầu bằng tháng 7 thì dòng đầu là dòng 11, bỏ trống từ dòng 5-10(6 dòng).

Cám ơn thày Ba Tê. vì bài giải nào của các bạn, nhà em cũng tải về để học hỏi, bài nào vướng, hoặc không hiểu phải hỏi lại cho rõ thôi . Bạn Leonguyenz mình không có ý khác đâu .

 

[xuan.nguyen82]

Xin XN82 suy nghỉ tiếp đi nha, nhưng chớ có căng quá!

(Tình hình là vết mổ của em nó .."căng" thôi ạ....hihi. Em cũng "nhồi" kiến thức từ từ, dần dần....Nên các thầy ra đề cho học sinh "mẫu giáo" như em có thể giải được í ạ. Những bài khó là em...chạy...hic hic).

Trong trường hợp giả sử khảo sát số liệu từ quý II năm 2011 đến hết quý I năm 2012 (số liệu giả định):

Public Sub Xuan2()
Dim Dau As Long, Cuoi As Long, I As Long, SoThang As Long
With Sheet1
.[A5:B1000].ClearContents
Dau = DateSerial(Year(.[C1]), Month(.[C1]), 1)
Cuoi = DateSerial(Year(.[C2]), Month(.[C2]), 1)
SoThang = DateDiff("m", Dau, Cuoi) + 1
For I = 1 To SoThang
    .Cells(I + 4, 1).Value = I
    .Cells(I + 4, 2).Value = "Thang " & Format(DateSerial(Year(Dau), Month(Dau) + I - 1, 1), "mm/yyyy")
Next I
End With
End Sub